excelvba

Save captured screenshot as JPG with VBA


I have a macro that will capture a screen with keyboard events and save the screenshot to an Excel file.

DoEvents
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0&
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0&
DoEvents

capturesFile.Worksheets(capturesFile.Worksheets.Count).Paste Destination:=curWS.Cells(rowNum + 2, 2)

I want to save the same screenshot as a JPG file in a folder, before saving it to the Excel file.

I capture any screen (Desktop, Skype, Outlook, some folder, some Web page, it could be anything).
Saving the screenshot as a JPG file has no relation to the Excel file.


Solution

  • I had small difficulties with the solution of PEH, so I used his method to make this version. On my computer (Window 10, Office 2010 is running well.)

    Sub SaveScreenshotAsJpeg()
        'make your screenshot here (so it is in the clipboard) …
        Dim ws As Worksheet
        Set ws = ThisWorkbook.Sheets.Add
        ws.Paste ' Past to the worksheet. It is a shape.
        Dim TempPicture As Shape
        On Error Resume Next ' Test if it succedded. Clipboard could be empty or text ...
            Set TempPicture = ws.Shapes(1)
        On Error GoTo 0
        If TempPicture Is Nothing Then
            MsgBox "Pasting picture was not successfull (not on clipboard). End."
            ws.Delete ' delete the unused worksheet
            Exit Sub
        End If
        TempPicture.CopyPicture 'copy again, since it was removed from clipboard.
        'create a chart with the exact size of the picture
        Dim TempChart As ChartObject
        Set TempChart = ws.ChartObjects.Add(0, 0, TempPicture.Width, TempPicture.Height)
        With TempChart.Chart 'paste the screenshot into the chart
            .ChartArea.Select
            .Paste
        End With
        'export the chart
        TempChart.Chart.Export Filename:="C:\Temp\test.jpg", FilterName:="JPEG"
        ws.Delete ' delete the unused worksheet with all its objects
    End Sub