1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32
| Sub enrgQR()
Dim derlig As Integer
Dim I As Integer
Dim QRname As String
Dim Plage As Range
derlig = Cells(Rows.Count, 2).End(xlUp).Row
For I = 6 To derlig
QRname = Replace(Cells(I, 2).Value, Chr(10), "_")
'Copie, en tant qu'image, les cellulesZ1
Set Plage = Sheets("Feuil1").Range("C" & I)
Plage.CopyPicture
Feuil1.Paste
'Crée un graphique temporaire
With Feuil1.ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height).Chart
.Paste
'exporte l'image sur le disque dur, dans le même répertoire que ce classeur.
.Export ThisWorkbook.Path & "\" & QRname & ".jpg", "JPG"
End With
With Feuil1
'Supprime le graphique temporaire
.ChartObjects(Feuil1.ChartObjects.Count).Delete
'Supprime l'image dans la feuille.
.Shapes(Feuil1.Shapes.Count).Delete
End With
Next
End Sub |
Partager