Copy of screen shot to sent to email is chopping off the last few columns

[JannetteChristie]

Hello,
I have the following sheet that when the user saves it then copies to an email but it is cutting off the last few columns.
The VB code I am using is as follows:

Sub CreatePNG(Namesheet As String, nameRange As String, nameFile As String)
    'ThisWorkbook.Activate
    'Worksheets(Namesheet).Activate
    Dim Plage As Range
    Set Plage = ThisWorkbook.Worksheets("Report").Range(nameRange)
    Plage.CopyPicture
    With ThisWorkbook.Worksheets(Namesheet).ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height)
        .Activate
        .Chart.Paste
        .Chart.Export nameFile, "JPG"
    End With
    Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Delete
Set Plage = Nothing
Worksheets("Report").Activate
End Sub

The report

When it copies to the email columns S to to V are missing, can anyone advise what I can do to prevent this from happening.

Thanks

 

[pitchoute]

Could you try updating your VBA code like this and see if it works?

Sub CreatePNG(Namesheet As String, nameRange As String, nameFile As String)
    Dim Plage As Range
    Dim tempSheet As Worksheet
    Dim myPic As Shape
    Dim FileFormat As String
    
    FileFormat = "JPG"
    
    Set Plage = ThisWorkbook.Worksheets("Report").Range(nameRange)
    
    Plage.CopyPicture xlScreen, xlPicture
    
    Set tempSheet = ThisWorkbook.Worksheets.Add
    
    tempSheet.Paste
    
    Set myPic = tempSheet.Shapes(tempSheet.Shapes.Count)
    
    myPic.Left = 0
    myPic.Top = 0
    
    myPic.Export Filename:=nameFile, FilterName:=FileFormat
    
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True
    
    Set Plage = Nothing
    Set myPic = Nothing
    Set tempSheet = Nothing
End Sub

 

[Logit]

Pardon me for squeezing in here ... How does one call that sub "CreatePNG" from a command button ?
Since the macro name as parameters ... I'm at a loss.

 

[JannetteChristie]

Could you try updating your VBA code like this and see if it works?

Sub CreatePNG(Namesheet As String, nameRange As String, nameFile As String)
    Dim Plage As Range
    Dim tempSheet As Worksheet
    Dim myPic As Shape
    Dim FileFormat As String
   
    FileFormat = "JPG"
   
    Set Plage = ThisWorkbook.Worksheets("Report").Range(nameRange)
   
    Plage.CopyPicture xlScreen, xlPicture
   
    Set tempSheet = ThisWorkbook.Worksheets.Add
   
    tempSheet.Paste
   
    Set myPic = tempSheet.Shapes(tempSheet.Shapes.Count)
   
    myPic.Left = 0
    myPic.Top = 0
   
    myPic.Export Filename:=nameFile, FilterName:=FileFormat
   
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True
   
    Set Plage = Nothing
    Set myPic = Nothing
    Set tempSheet = Nothing
End Sub

Hi @pitchoute
Thanks for your response, I am getting an error on the following line:
myPic.Export Filename:=nameFile, FilterName:=FileFormat


I am not able to resolve this.

 

[JannetteChristie]

Further update to this,

When the JPG file is automatically added to the file it send it all squashed together.
If I open an email and manually add the JPG to the body of the email there is no issue.

I am struggling to wok out what the issue is here - is there any help available please ?