Makro ile alınan ekran görüntüsünü masaüstüne kaydetme

[canercaneryilmaz]

Merhabalar
Application. Sendkeys “(%{1068})” yöntemiyle ekran görüntüsü alıyorum. Bunu masaüstüne jpg olarak nasıl kaydedebilirim.

 

[Asri]

Sub EkranAl()
    Application.SendKeys "({1068})", True
    DoEvents
    ActiveSheet.Paste
    
    Application.Wait (Now + TimeValue("00:00:02"))
    Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\EkranResmi.jpg"
    
    Set oshape = Selection
    Application.Selection.CopyPicture
    Set oDia = ActiveSheet.ChartObjects.Add(0, 0, oshape.Width, oshape.Height)
    Set oChartArea = oDia.Chart
    oDia.Activate
    With oChartArea
        .ChartArea.Select
        .Paste
        .Export (Path)
    End With
    
    oDia.Delete
    oshape.Delete
End Sub