Loop issue to export picture


New Member
Oct 22, 2019
Hi all,

I want to export a group of shapes as an image.
The group consists of various shapes that are displayed / hidden based on user selection and show incident types on a map.
All I want is to export this map to a JPG.

I have crafted a script from various finds online, it works sometimes, but it's still not error free.
  1. It's updating the timestamp shown on the map
  2. selecting the image group (Group 100)
  3. pasting it as an image into cell G107
  4. creating a chart
  5. places the image into the chart
  6. Chart is exported as a JPG with a defined file name driven by the user's selection of incident types.
  7. The chart and image gets deleted.
The user selection (incident type) is driven by cell E3.

The code runs through all worksheets, which is in fact not required. I will only ever have one chart and one image on this worksheet.

I hope you can guide me spot the mistake I have made.

Sub ExportAllPictures()
    Dim MyChart As Chart
    Dim n As Long, shCount As Long
    Dim Sht As Worksheet
    Dim PictureFileName As String
    Dim PictureNumber As Integer
    Dim PictureName As String
    Dim shp As Shape
    Application.ScreenUpdating = False
    PictureFileName = Range("E3")
    PictureName = "Picture"
    PictureNumber = 1
    ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(""As per "",TEXT(NOW(),""dd/mm/yy  hh:mm AM/PM""))"
    ActiveSheet.Shapes.Range(Array("Group 100")).Select
    For Each Sht In ActiveWorkbook.Sheets
        shCount = Sht.Shapes.Count
        If Not shCount > 0 Then Exit Sub

        For n = 1 To shCount
            If InStr(Sht.Shapes(n).Name, "Picture") > 0 Then
                'create chart as a canvas for saving this picture
                Set MyChart = Charts.Add
                MyChart.Name = "TemporaryPictureChart"
                'move chart to the sheet where the picture is
                Set MyChart = MyChart.Location(Where:=xlLocationAsObject, Name:=Sht.Name)

                'resize chart to picture size
                MyChart.ChartArea.Width = Sht.Shapes(n).Width
                MyChart.ChartArea.Height = Sht.Shapes(n).Height
                MyChart.Parent.Border.LineStyle = 0 'remove shape container border

                'copy picture

                'paste picture into chart

                'save chart as jpg
                MyChart.Export Filename:=Sht.Parent.Path & "\NetworkMap - " & PictureFileName & ".jpg", FilterName:="jpg"

                'delete chart
                Sht.Cells(4, 3).Activate
                'delete pictures
                For Each shp In ActiveSheet.Shapes
                If shp.Type = msoPicture Then shp.Delete
                Next shp
            End If
    Next Sht
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.ScreenUpdating = True
End Sub
Currently it sometimes errors at
If InStr(Sht.Shapes(n).Name, "Picture") > 0 Then
with a runtime error: "The index into the specified collection is out of bounds."

It only happens sometimes and I haven't worked out the pattern yet.

I suspect it's because of the Picture name not being found in the loop. Is anyone able to help?

Thank you very much!


Well-known Member
Oct 17, 2005
Office Version
Hi Slangy,
my hunch is that the picture numbering/indexing is not a neat sequential list (1,2,3,4,etc), but that there is some item skipped/missing. So if you have 4 items with index values (1,2,3,5), you will loop through 1-4 and get an error on number 4 as it doesn't exist.

So try a For Each loop for the Shapes:
For Each Sht In ActiveWorkbook.Sheets
For Each Shp in Sht.Shapes
Next Shp
Next Sht

Hope that helps,

Forum statistics

Latest member

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...