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!

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.


Well-known Member
Oct 17, 2005
Office Version
  1. 365
  1. Windows
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,

Watch MrExcel Video

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back