J'ai effectué un code qui permet de créer et effacer des qr-codes, techniquement, il fonctionne cependant j'aimerais si possible l'améliorer.
Ci-joint, les deux codes.
Sub Zebra()
Dim enregistrement As Range
Dim donnee As String
Dim newforme As Shape
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set x = Worksheets("Qr-Code")
Set newfeuille = Worksheets("Qr-Code")
'Selectionne les données d'entrées pour les QR-codes
Worksheets("Qr-Code").Activate
I = Range("A2")
V = "%09"
L = "%0D"
'1er QR-code sur la feuille
Set cellule = newfeuille.Range("C1")
donnee = "http://api.qrserver.com/v1/create-qr-code/?data=" & I & V & L & "&size=250x250"
Set newforme = x.Shapes.AddShape(msoShapeRectangle, cellule.Left, cellule.Top, 55, 55)
newforme.Name = "QR1"
newforme.Line.Visible = False 'enlève la ligne de contour
newforme.Fill.UserPicture (donnee) 'insère l'image dans la forme
Range("C5") = I
'2nd QR-code sur la feuille
Set cellule = newfeuille.Range("D1")
donnee = "http://api.qrserver.com/v1/create-qr-code/?data=" & I & V & L & "&size=250x250"
Set newforme = x.Shapes.AddShape(msoShapeRectangle, cellule.Left, cellule.Top, 55, 55)
newforme.Name = "QR2"
newforme.Line.Visible = False 'enlève la ligne de contour
newforme.Fill.UserPicture (donnee) 'insère l'image dans la forme
Range("D5") = I
'3ème QR-code sur la feuille
Set cellule = newfeuille.Range("C7")
donnee = "http://api.qrserver.com/v1/create-qr-code/?data=" & I & V & L & "&size=250x250"
Set newforme = x.Shapes.AddShape(msoShapeRectangle, cellule.Left, cellule.Top, 55, 55)
newforme.Name = "QR3"
newforme.Line.Visible = False 'enlève la ligne de contour
newforme.Fill.UserPicture (donnee) 'insère l'image dans la forme
Range("C11") = I
'4ème QR-code sur la feuille
Set cellule = newfeuille.Range("D7")
donnee = "http://api.qrserver.com/v1/create-qr-code/?data=" & I & V & L & "&size=250x250"
Set newforme = x.Shapes.AddShape(msoShapeRectangle, cellule.Left, cellule.Top, 55, 55)
newforme.Name = "QR4"
newforme.Line.Visible = False 'enlève la ligne de contour
newforme.Fill.UserPicture (donnee) 'insère l'image dans la forme
Range("D11") = I
End Sub
Sub effacer()
Dim newforme As Shape
'effacer le 1er Qr code'
Range("C5").Clear
ActiveSheet.Shapes("QR1").Delete
'effacer le 2nd Qr code'
Range("D5").Clear
ActiveSheet.Shapes("QR2").Delete
'effacer le 3ème Qr code'
Range("C11").Clear
ActiveSheet.Shapes("QR3").Delete
'effacer le 4ème Qr code'
Range("D11").Clear
ActiveSheet.Shapes("QR4").Delete
End Sub
