Coba Paka ini dh

Versi 1 (modif dari ente punya+ sedikit Api unggun) :

'Declare Windows API Functions
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
  bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
 
'Declare Virtual Key Codes
Private Const VK_SNAPSHOT = &H2C
Private Const VK_KEYUP = &H2
Private Const VK_MENU = &H12
Public Const VK_TAB = &H9
Public Const VK_ENTER = &HD
 
Sub CaptureMe()
Application.ScreenUpdating = False
    'Press Alt + TAB Keys -- Step1
    Alt_Tab
 
    'Press Print Screen key using Windows API -- Step2.
    keybd_event VK_SNAPSHOT, 1, 0, 0 'Print Screen key down
    keybd_event VK_SNAPSHOT, 1, VK_KEYUP, 0 'Print key Up - Screenshot to Clipboard
 
    'Paste Image in Chart and Export it to Image file. -- Step3
    Charts.Add
    ThisWorkbook.Charts(1).AutoScaling = True
    ThisWorkbook.Charts(1).Paste
    ThisWorkbook.Charts(1).Export Filename:="C:\Temp\ClipBoardToPic.jpg", Filtername:="jpg" 
 
End Sub
 
Sub Alt_Tab()
    DoEvents
    keybd_event VK_MENU, 1, 0, 0 'Alt key down
    DoEvents
    keybd_event VK_TAB, 0, 0, 0 'Tab key down
    DoEvents
    keybd_event VK_TAB, 1, VK_KEYUP, 0 'Tab key up
    DoEvents
    keybd_event VK_ENTER, 1, 0, 0 'Tab key down
    DoEvents
    keybd_event VK_ENTER, 1, VK_KEYUP, 0 'Tab key up
    DoEvents
    keybd_event VK_MENU, 1, VK_KEYUP, 0 'Alt key up
    DoEvents
End Sub

Sub SendEmail()
On Error Resume Next
Application.ScreenUpdating = False
Call CaptureMe
Dim olApp As Object '/Outlook.Application
Set olApp = CreateObject("outlook.application")
Dim olMail As Object '/Outlook.mailitem
Set olMail = olApp.CreateItem(olmailitem)
olMail.To = "YourMail@Gmail.com"
olMail.Subject = "IST End of Day snapshots as of 21 April 2017 " ' or use this : & Format(Now - 1, "dd Mmm YYYY")
'olMail.body = "Good Morning, This Is Detail Dashboard for Today"
olMail.HTMLBody = "<br>Good Morning, This Is Detail Dashboard for Today<br>" _
                & "<img src='C:\Temp\ClipBoardToPic.jpg'" & "width='500' height='200'><br>" _
                & "<br>Best Regards, <br>YourNameHere</font></span>"
olMail.send

OutApp.Session.Logoff
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

Versi 2 yg lebih simple dengan Sendkeys methode :

Sub SendEmailV2()

'Version : 2
'simle way : using sendkeys mode + wait 
Dim OutApp As Object
Dim OutMail As Object

'Shift-Print Screen
Application.SendKeys "(%{1068})"
On Error Resume Next

'Prepare the email
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "Fujiansyah.achmad@dhl.com"
.Subject = "IST End of Day snapshots as of 21 April 2017 " ' or use this : & Format(Now - 1, "dd Mmm YYYY")
.Display

Application.Wait Now + TimeValue("00:00:01")
Application.SendKeys ("Good Morning, This Is Detail Dashboard for Today")
Application.SendKeys ("{ENTER}")
Application.Wait Now + TimeValue("00:00:01")
Application.SendKeys "(^v)"
Application.Wait Now + TimeValue("00:00:01")
Application.SendKeys "(%S)"

End With
On Error GoTo 0

OutApp.Session.Logoff
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

semoga sedikit membantu

[attachment:590153bf7cd55]