Loop issue to export picture

Slangy

New Member
Joined
Oct 22, 2019
Messages
3
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.

Code:
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
    
    ActiveSheet.unprotect
     
    Application.ScreenUpdating = False
    
    PictureFileName = Range("E3")
    PictureName = "Picture"
    PictureNumber = 1
    
    Range("L6").Select
    ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(""As per "",TEXT(NOW(),""dd/mm/yy  hh:mm AM/PM""))"
    
    ActiveSheet.Shapes.Range(Array("Group 100")).Select
    Selection.Copy
    Range("G107").Select
    ActiveSheet.Pictures.Paste.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
                Sht.Shapes(n).Copy


                'paste picture into chart
                MyChart.ChartArea.Select
                MyChart.Paste


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




                'delete chart
                Sht.Cells(4, 3).Activate
                Sht.ChartObjects(Sht.ChartObjects.Count).Delete
                
                'delete pictures
                For Each shp In ActiveSheet.Shapes
                If shp.Type = msoPicture Then shp.Delete
                Next shp
        
            End If
        Next
    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

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Rijnsent

Well-known Member
Joined
Oct 17, 2005
Messages
1,300
Office Version
  1. 365
Platform
  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,
Koen
 

Watch MrExcel Video

Forum statistics

Threads
1,123,452
Messages
5,601,748
Members
414,471
Latest member
cchunyadi

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
Top