Script exports only white images

Question

I am trying to automatically export pictures of every sheet of my workbook.

When I check the Export Folder I see, that there are only correct formatted images (Height and Width) as blank white without any content.

Sub ExportWorkbookAsImage()
Dim ws As Worksheet
Dim strSheetName As String
Dim sView As String
For Each ws In ThisWorkbook.Worksheets
    sView = ActiveWindow.View
    strSheetName = ws.Name
    zoom_coef = 100 / ws.Parent.Windows(1).Zoom
    Set area = ws.Range(ws.Cells(1, 1), ws.Cells.SpecialCells(xlCellTypeLastCell))
    area.CopyPicture xlPrinter
    Set chartobj = ws.ChartObjects.Add(1, 1, area.Width * zoom_coef, area.Height * zoom_coef)
    With chartobj
        .Chart.Paste
        .Activate
        .Chart.Export "C:\Users\PC\Desktop\Neuer Ordner" & "\" & strSheetName & ".jpg"
        .Delete
    End With

Next ws
End Sub

Does this answer your question? [Export chart as image - with click of a button](https://stackoverflow.com/questions/11939087/export-chart-as-image-with-click-of-a-button) — braX, Nov 17 '21 at 22:16

score 0 · Answer 1 · answered Nov 18 '21 at 01:05

I made some changes to your code, basically selecting the desired range and pasting it as a picture. Then copying/pasting this picture inside the temporary chart object.

Sub ExportWorkbookAsImage()

    Dim ws As Worksheet
    Dim strSheetName As String
    Dim sView As String
    Dim activeShape As Shape

    For Each ws In ThisWorkbook.Worksheets
        ws.Activate
            
        Range(ws.Cells(1, 1), ws.Cells.SpecialCells(xlCellTypeLastCell)).Select
        Selection.Copy
        ActiveSheet.Pictures.Paste(link:=False).Select
        Set activeShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)
        
        Set chartObj = ActiveSheet.ChartObjects.Add(Left:=ActiveCell.Left, _
                                                    Width:=activeShape.Width, _
                                                    Top:=ActiveCell.Top, _
                                                    Height:=activeShape.Height)
        With chartObj
            .ShapeRange.Fill.Visible = msoFalse
            .ShapeRange.Line.Visible = msoFalse
            
            activeShape.Copy
            .Activate
            ActiveChart.Paste
            .Chart.Paste
            .Activate
            .Chart.Export "C:\Users\PC\Desktop\Neuer Ordner\" & ws.Name & ".jpg"
            .Delete
            activeShape.Delete
        End With
    
    Next ws

End Sub

Thank you for your help. Unfortunately the script fails in the second sheet with a failure. -> ActiveSheet.Pictures.Paste(link:=False).Select is the Breakpoint. When i press F5 the whole time the script works fine and does what it should. — Markus Bücher, Nov 18 '21 at 21:15
Okay, the cript works when i deactivate the clipboard function. That's it. Thank you :) — Markus Bücher, Nov 19 '21 at 18:06

Script exports only white images

1 Answers1