Search code examples
excelvba

Screenshot of a range in Excel, which is then saved as a PNG file


I have created a VBA code that copies a range of an Excel worksheet as an image and copies it into a new worksheet. It should then export this image as a PNG file and save it. Unfortunately, this last step always results in a white chart.

Sub TakeScreenshotAsPNG(sheetName As String, rangeAddress As String, imagePath As String)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(sheetName)
    Dim picRange As Range
    Set picRange = ws.Range(rangeAddress)

    ' Debugging: Check the range
    MsgBox "Range address: " & picRange.Address
    Debug.Print "Range address: " & picRange.Address

    ' Ensure the range is visible
    ws.Activate
    picRange.Select
    DoEvents ' Ensure Excel updates the range

    ' Copy the range as a picture
    picRange.CopyPicture xlScreen, xlBitmap

    ' Debugging: Check if the picture was copied
    On Error GoTo CopyPictureError
    MsgBox "Picture copied successfully."
    On Error GoTo 0

    ' Create a new workbook
    Dim newWorkbook As Workbook
    Set newWorkbook = Workbooks.Add

    ' Add a new worksheet to the new workbook
    Dim newSheet As Worksheet
    Set newSheet = newWorkbook.Sheets(1)

    ' Paste the picture into the new sheet
    newSheet.Paste
    DoEvents ' Allow Excel to process the paste operation

    ' Debugging: Check if the picture was pasted
    MsgBox "Picture pasted successfully into new worksheet."

    ' Save the workbook temporarily to the Desktop to check the picture
    Dim tempPath As String
    tempPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\TempWorkbook.xlsx"
    newWorkbook.SaveAs tempPath

    ' Debugging: Display the temporary file
    MsgBox "Temporary file saved: " & tempPath

    ' Export the new sheet as a PNG file
    Dim chartObj As ChartObject
    Set chartObj = newSheet.ChartObjects.Add(0, 0, picRange.Width, picRange.Height)
    newSheet.Shapes(1).Copy
    chartObj.Chart.Paste
    chartObj.Chart.Export Filename:=imagePath, FilterName:="png"

    ' Close the new workbook without saving
    newWorkbook.Close SaveChanges:=False

    ' Debugging: Check if the picture was exported
    On Error GoTo ExportPictureError
    MsgBox "Picture exported successfully: " & imagePath
    On Error GoTo 0

    Exit Sub

CopyPictureError:
    MsgBox "Error copying picture."
    Exit Sub

ExportPictureError:
    MsgBox "Error exporting picture."
    Exit Sub
End Sub

The problem is not due to the range or the first copying process, which works perfectly. My guess is that it is due to the following part:

' Export the new sheet as a PNG file
 Dim chartObj As ChartObject
 Set chartObj = newSheet.ChartObjects.Add(0, 0, picRange.Width, picRange.Height)
 newSheet.Shapes(1).Copy
 chartObj.Chart.Paste
 chartObj.Chart.Export Filename:=imagePath, FilterName:="png"

I have already installed various debugging steps and played around, unfortunately always with the same result that a white chart comes out


Solution

  • You have some unnecessary steps in your code:

    • No need to activate the sheet where the range is located. CopyPicture works even when the sheet is not active.
    • No need to first copy the range-image as shape into the new workbook and then copy&paste it again from there.
    • No need to save the temporary workbook.

    The reason that the image file is empty is because the Paste-method of the chart fails to copy the image. For some strange reasons, it works only if the chart is set to active.

    Sub TakeScreenshotAsPNG(sheetName As String, rangeAddress As String, imagePath As String)
        
        Dim picRange As Range
        Set picRange = ThisWorkbook.Worksheets(sheetName).Range(rangeAddress)
        
        ' Create a new workbook
        Dim newWorkbook As Workbook
        Set newWorkbook = Workbooks.Add
        Dim newSheet As Worksheet
        Set newSheet = newWorkbook.Sheets(1)
    
        ' Copy the range as a picture
        picRange.CopyPicture xlScreen, xlBitmap
        
        ' Create a chart and paste the image
        Dim chartObj As ChartObject
        Set chartObj = newSheet.ChartObjects.Add(0, 0, picRange.Width, picRange.Height)
        chartObj.Activate   ' <-- This is needed!
        chartObj.Chart.Paste
        chartObj.Chart.Export Filename:=imagePath
    
        ' Close the new workbook without saving
        newWorkbook.Close SaveChanges:=False
    End Sub
    

    If I were you, I would change the definition of the Routine. In VBA, it's hardly ever needed to know the name of a sheet or the range address. Instead, pass the range you want to use directly as Range variable:

    Sub TakeScreenshotAsPNG(picRange As Range, imagePath As String)