Recherche d'amélioration de code

Matthieu -  
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   -

Bonjour,

J'ai créé un code qui crée sous Excel des QR-codes, cependant, je voudrais l'améliorer.

J'aimerais pouvoir créer 4 QR-codes d'un coup, tous dans un carré de 10X10cm de côté.

De plus, j'aimerais que le fond derrière les QR-codes soit uni et qu'il y ait des délimitations entre chaque QR-code.

Enfin, j'aimerais que la chaine de caractères entrée dans la case "A2" qui génère les QR-codes, soit affichée sous chaque QR-code.

Je vous met ci-joint le code actuel en italique pour faciliter la visibilité.

Sub Zebra()

Dim enregistrement As Range
Dim donnee As String
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, 94, 94) '94, 94 indique la taille de la forme'1 pixel = 0.0264583333 cm donc 94 pixels = 5cm)
newforme.Line.Visible = False 'enlève la ligne de contour
newforme.Fill.UserPicture (donnee) 'insère l'image dans la forme
'Affiche le nom du QR-code
I = newforme.Name
Range("J1") = I
Range("J1").Select 'Police blanche
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With

End Sub

Merci d'avance et bonne journée.

Matthieu

Windows / Edge 106.0.1370.47

A voir également:

2 réponses

Réponse 1 / 2
Matthieu
 

J'ai vraiment besoin d'aide s'il vous plait ! 
Je suis dessus et je n'y arrive pas.
0
Réponse 2 / 2
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 

Bonjour,

essaie ceci:

Sub Zebra()
Dim enregistrement As Range
Dim donnee As String
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"
For j = 3 To 12 Step 2
'1er QR-code sur la feuille
Set cellule = newfeuille.Cells(1, j)
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, 94, 94) '94, 94 indique la taille de la forme'1 pixel = 0.0264583333 cm donc 94 pixels = 5cm)
newforme.Line.Visible = False 'enlève la ligne de contour
newforme.Fill.UserPicture (donnee) 'insère l'image dans la forme
'Affiche le nom du QR-code
' newforme.Name = i
Cells(8, j) = Range("A2") 'newforme.Name
Cells(8, j).Select 'Police noire
    With Selection.Font
        .ColorIndex = 1  'xlThemeColorDark1
        .TintAndShade = 0
    End With
Next j
End Sub
0
Matthieu
 

Bonjour, merci pour votre réponse et désolé pour le doublon, je n'avais pas vu que vous m'aviez déjà répondu.

Cependant, si j'ai ouvert une nouvelle discussion, c'était pour montrer que le code avait changé et que je recherchais pas la même chose du coup.

J'ai essayé ce code et j'avoue que cela n'a pas fonctionné cependant, étant assez mauvais en VBA, je n'ai pas vraiment compris pourquoi.

Merci d'avance pour toute autre réponse (si possible concernant le deuxième sujet de discussion).

Cordialement 

0
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729 > Matthieu
 

Voilà une macro diminuée de moitié:

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"
c = 3
For j = 1 To 2
'1er QR-code sur la feuille
Set cellule = newfeuille.Cells(1, c)
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 = "QR" & j
newforme.Line.Visible = False 'enlève la ligne de contour
newforme.Fill.UserPicture (donnee) 'insère l'image dans la forme
Cells(5, c) = i
c = c + 1
Next j
c = 3
For j = 1 To 2
Set cellule = newfeuille.Cells(7, c)
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 = "QR" & j + 2
newforme.Line.Visible = False 'enlève la ligne de contour
newforme.Fill.UserPicture (donnee) 'insère l'image dans la forme
Cells(11, c) = i
c = c + 1
Next j
End Sub
Sub EffaceShapesSaufBoutons()
   For Each i In ActiveSheet.Shapes
     If i.Type <> 8 And i.Type <> 12 Then
       ActiveSheet.Shapes(i.Name).Delete
     End If
   Next i
End Sub

j'ai ajouté l'effacement des Qrcodes:

Sub EffaceShapesSaufBoutons()

Voilà

@+ Le Pivert

0

Discussions similaires

[référencement] Ne pas être référencé
kij_82 -
Searaphina -

10 réponses