VBA Copy Screen Shot of Excel Sheet into Email and Send


New Member
Sep 28, 2017
I am not the nest with VBA so I have searched around the internet and come up with the following code that allows a user to press a button, a screen shot of the worksheet captured which is then pasted into an Outlook message which can then be sent to myself. This is being used for training and a record of this training.

It works 95% of the time but I have two problems with this
1) The VBA that I have seems to have been created for graphs. Not always but sometimes, a graph will appear in the screenshot even though there is no graph within the excel sheet. Sometimes this completely overwrites the worksheet and sometimes it only appears slightly but messes with the formatting. A screenshot of this is shown at https://screenshot.net/eyqo4t1
2) I have tested this worksheet successfully on three out of four PCs. The one PC that it did not work on, it only took a plain white screen shot (showing nothing). This PC is using Office 2016 whereas the others, including mine, use 2013. I need this to work on both versions of Office.

Below is my code

Private Sub cmdMainMenu_Click()


End Sub

Private Sub cmdEmail_Click()

'Application.ScreenUpdating = False     ' this stops new chart from being displayed all the time - this seems to produce a white screen

Dim oRange As Range
Dim oCht As Chart
Dim oImg As Picture

Set oRange = Range("A1:P34")
Set oCht = Charts.Add

oRange.CopyPicture xlScreen, xlPicture
oCht.Export Filename:="C:\_Training\_System\Completed_Module.jpg", Filtername:="JPG"

    Application.DisplayAlerts = False     ' turns prompts off so that chart is deleted automatically; no user prompt
    Application.DisplayAlerts = True     ' turns prompts back on
    MsgBox "Images have been created.     ", vbInformation     'messagebox with text and OK-button

Application.ScreenUpdating = True     ' this turns screen updating back on.
'ActiveSheet.Protect       ' place at end of code

Screenshot_Mail "me@emailaddress.co.uk" & "; " & "", "" & _
 "; " & "" & "; " & "", Range("R1"), "[COLOR=red]" & _
"[I]" & "Below is a Snapshot View of the Training Completed:  " & "[/I][/COLOR][I]" & "[/I]" & _
" & "
" & "******>[FONT=Arial][SIZE=2][COLOR=#000080][/COLOR][/SIZE][/FONT]" & _
"[IMG]https://www.mrexcel.com/forum/_Training\_System\Completed_Module.jpg[/IMG] "

End Sub

Private Sub cmdPrint_Click()


Dim sh As Worksheet
Dim rngPrint As Range
Set sh = ActiveSheet
Set rngPrint = ActiveCell.CurrentRegion
With sh.PageSetup
    .Orientation = xlLandscape
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
End With



End Sub
Can someone help with any tweaks or amendments that I can make to this to try to stop these problems?



Well-known Member
Oct 15, 2013
Re: Help: VBA Copy Screen Shot of Excel Sheet into Email and Send

Ron DeBruin has an awesome blog on sending email via excel.. Note: might run into issues if Excel and Outlook are not the same version

<!--StartFragment-->Sub Mail_Selection_Range_Outlook_Body()
[COLOR=black]'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Don't forget to copy the function RangetoHTML in the module.
'Working in Excel 2000-2016[/COLOR]
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
    [COLOR=black]'Only the visible cells in the selection[/COLOR]
    [COLOR=#000000]'Set rng = Selection.SpecialCells(xlCellTypeVisible)[/COLOR]
    'You can also use a fixed range if you want
    Set rng = Range("A1:P34").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = "Below is a Snapshot View of the Training Completed:" & "<.br><.br>" & RangetoHTML(rng)  'Remove the dots in the "br" portion of the string
        .Send   [COLOR=black]'or use .Display[/COLOR]
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Function RangetoHTML(rng As Range)
[COLOR=black]' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object[/COLOR]
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    [COLOR=black]'Copy the range and create a new workbook to past the data in[/COLOR]
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        On Error GoTo 0
    End With

    [COLOR=black]'Publish the sheet to a htm file[/COLOR]
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
        .Publish (True)
    End With

    [COLOR=black]'Read all data from the htm file into RangetoHTML[/COLOR]
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    [COLOR=black]'Close TempWB[/COLOR]
    TempWB.Close savechanges:=False

    [COLOR=black]'Delete the htm file we used in this function[/COLOR]
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function<!--EndFragment-->


New Member
Sep 28, 2017
Re: Help: VBA Copy Screen Shot of Excel Sheet into Email and Send

Thank you very much for this - it is easily laid out for me to be able to follow the basics of it and it works well across all computers

Forum statistics

Latest member

Some videos you may like

This Week's Hot Topics