macro exportar imagenes de varios rangos de una en una

[txingui]

Hola nuevamente a todos, sigo con mi "pelea particular" para terminar un editor de roadbook y como dije en otra consulta anterior sufro el refran ese de "el que no sabe es como el que no ve...", a pesar de todo y a base de "cabezazos algo va saliendo pero nuevamente me encuentro con una solución que no consigo resolver.

El tema, exportar las imágenes creadas en rangos "sucesivos" de forma unitaria y relacionando "su nombre" al dato de una casilla adjunta, aprovechando macros de terceros adaptadas no tengo problema para "crear" imágenes de rangos definidos o una imagen "general" de rangos "utilizados" pero esto no doy con el "loop" necesario.

Dejo un parcial del libro donde se entenderá mejor lo que os he comentado y quedo a la espera de vuestros comentarios y ayuda

 

un saludo

 

[txingui]

resuelto, adjunto "mi solución" que seguro es muy mejorable...

Lo primero que he necesitado es numerar (añadir datos..) en el rango de casillas donde tengo las viñetas porque no he sabido hacer para que se "reconocieran" los conectores, esto lo he resuelto con esta macro

Sub numerar_viñetas()

nFilas = Cells(Rows.Count, 1).End(xlUp).Row

nFila = 1
For i = 41 To nFilas + 41
    If Cells(i, 1) <> "" Then
        Cells(i, 4) = nFila
        nFila = nFila + 1
    End If
Next
End Sub

 

una vez disponen de datos he añadido una nueva hoja en la cual se van "copiando -descargando" las imágenes que son "ordenadas por números" según el valor de un "contador" puesto en una casilla quedando la macro así

Sub Exportar_viñetas()
Application.ScreenUpdating = False
Sheets("ROADBOOK").Select
Call numerar_viñetas
Range("D41").Select
Do While ActiveCell <> ""
If Not IsEmpty(ActiveCell.Value) Then
ActiveCell.Select
With Selection.CopyPicture(xlScreen, xlPicture)
End With
Sheets("hoja2").Select
Range("K1").Value = Range("K1").Value + 1
ActiveSheet.Shapes.AddChart
ActiveSheet.ChartObjects(1).Select
With Selection
Sheets("hoja2").Shapes.Item(1).Line.Visible = msoFalse
Sheets("hoja2").Shapes.Item(1).Width = Range("A1:A5").Width
Sheets("hoja2").Shapes.Item(1).Height = Range("A1:A5").Height
.Chart.Paste
.Chart.Export "E:\pruebas\" & Range("K1").Value & ".jpg"
.Delete
Sheets("ROADBOOK").Select
ActiveCell.Offset(1, 0).Select
End With
End If
Loop
Sheets("hoja2").Select
Range("K1").Value = "0"
Sheets("ROADBOOK").Select
End Sub

 

Como ya puse anteriormente, yo de excel lo justo así que si alguien tiene una mejor solución yo encantado de recibirla