VBA Loop Though Column of Data, Select Shape in offset column

[dcoker]

Hi.

I'm trying to figure out how to loop through column "I"
If it finds a cell that is blank, skip the row, move to next row until it finds a cell containing a value
Once it finds a cell with a value in column "I", select the picture in column "B" of the same row.

Once the picture is selected, export the picture.

Any help is appreciated!

 

[Yongle]

For FIRST test
- create a NEW test folder to export the images (to prevent overwriting anything)
- Place code in a new module
- Amend ONLY image export path "C:\Test\imagesFolder"
- Run code from sheet containing the images

Come back if you require further help

Sub ExportImages()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoPicture Then
            With shp.TopLeftCell
                If .Column = 2 And .Offset(, 7) <> "" Then Call ExportPicture(shp)
            End With
        End If
    Next shp
End Sub
    
Private Sub ExportPicture(pic As Shape)
    Const picPath = "C:\Test\imagesFolder"
    pic.Copy
    With ActiveSheet.ChartObjects.Add(0, 0, pic.Width, pic.Height)
        .Chart.ChartArea.Select
        .Chart.Paste
        .Chart.Export picPath & "\" & pic.Name & ".jpg"
        .Delete
    End With
End Sub

 

[dcoker]

For FIRST test
- create a NEW test folder to export the images (to prevent overwriting anything)
- Place code in a new module
- Amend ONLY image export path "C:\Test\imagesFolder"
- Run code from sheet containing the images

Come back if you require further help

Sub ExportImages()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoPicture Then
            With shp.TopLeftCell
                If .Column = 2 And .Offset(, 7) <> "" Then Call ExportPicture(shp)
            End With
        End If
    Next shp
End Sub
   
Private Sub ExportPicture(pic As Shape)
    Const picPath = "C:\Test\imagesFolder"
    pic.Copy
    With ActiveSheet.ChartObjects.Add(0, 0, pic.Width, pic.Height)
        .Chart.ChartArea.Select
        .Chart.Paste
        .Chart.Export picPath & "\" & pic.Name & ".jpg"
        .Delete
    End With
End Sub

That seems to work for the most part so far!
How / Where would I assign column "I" value as the new file name?
Thanks!

 

[dcoker]

I think I figured it out by adding the code below

'
shpfname = .Offset(, 7)
If .Column = 2 And .Offset(, 7) <> "" Then Call ExportPicture(shp, shpfname)

'

'

Private Sub ExportPicture(pic As Shape, shpfname As String)

'

.Chart.Export picPath & Left(shpfname, Len(shpfname) - 4) & "_thumb.jpg"

 

[Yongle]

your code in post#4 above suggests you are on the right track

 

[dcoker]

Yes! It works! Thank you for your help!