Amélioration de code

Fermé
Matthieu - Modifié le 20 oct. 2022 à 15:15
cs_Le Pivert Messages postés 7902 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 novembre 2023 - 20 oct. 2022 à 15:26

Bonjour,

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


 

Merci d'avance pour votre aide.

Bien cordialement


Windows / Edge 106.0.1370.47

A voir également:

1 réponse

cs_Le Pivert Messages postés 7902 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 novembre 2023 728
20 oct. 2022 à 15:26

Bonjour,

tu as eu une réponse ici 

https://forums.commentcamarche.net/forum/affich-37710740-recherche-d-amelioration-de-code#p37712496

la moindre des corrections c'est d'y répondre avant de faire un nouveau post (doublon)


2