Un nouvel essai pour prendre en compte que les lignes peuvent être masquées :
Sub LouReeD()
Dim Ligne, Sh As Object, ShWay, Largeur, Réponse, ColonneI, ColonneN
Réponse = InputBox("Veuillez indiquer la colonne du nom de ces images", "Désignation de la colonne pour le nom")
ColonneN = Asc(UCase(Réponse)) - 64
Réponse = InputBox("Veuillez indiquer la colonne des images", "Désignation de la colonne pour l'image")
ColonneI = Asc(UCase(Réponse)) - 64
' un petit test de cohérence mais il en faudrait d'autre...
If ColonneI = ColonneN Then MsgBox ("Ces colonnes ne peuvent être identiques..."): End
Application.ScreenUpdating = False
Ligne = 2
With ActiveSheet
Do
If .Cells(Ligne, ColonneN).Value = "" Then Exit Do
If .Cells(Ligne, ColonneN).EntireRow.Hidden = False Then
For Each Sh In .Shapes
If Not Intersect(.Cells(Ligne, ColonneI), Sh.TopLeftCell) Is Nothing Then
If Sh.Width < 500 Then
Largeur = Sh.Width
Sh.Width = 600
End If
Sh.Copy
With Sh.Parent.ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
While .Shapes.Count = 0
DoEvents
.Paste
Wend
ShWay = ActiveWorkbook.Path & "\" & ActiveSheet.Cells(Ligne, ColonneN).Value & ".Png"
.Export ShWay, "PNG"
.Parent.Delete
End With
Sh.Width = Largeur
Exit For
End If
Next
End If
Ligne = Ligne + 1
Loop
End With
End Sub
J'ai juste ajouté une condition "EntireRow.Hidden = Flase", comme quoi la ligne doit être visible pour que le code soit exécuté.
@ bientôt
LouReeD