XL 2016 QRcode HS [Résolu]

crackerwood · 29 Avril 2025

Bonjour aux gros bonnets du VBA.
Voilà dans le cas du travail je dois faire des QRcodes via excel. J'ai trouvé un fichier excel qui fonctionne bien sauf que les QRcode ne se créer pas.
Après quelques recherches je crois savoir que l'url api de google n'est plus. J'ai donc changé l'url mais à chaque création de qrcode le résultat est chs=80x80
Ma demande est la suivante : est-il possible de me corriger ça car là rien ne fonctionne quand je test. Le fichier permet de générer les qrcode est de les enregistrer en image dans un dossier.
Je me suis permis d'ajouter quelques infos dans le fichier pour vous expliquer.
En vous remerciant.

fanch55 · 29 Avril 2025

Bonjour,
Essayez avec un autre provider de QrCode :

VB:

Function URL_QRCode_SERIES( _
    ByVal QR_Value As String, _
    Optional ByVal PictureSize As Long = 100, _
    Optional ByVal DisplayText As String = "QRCode >>", _
    Optional ByVal Updateable As Boolean = True) As Variant

Dim PictureName As String
Dim oPic As Shape, oRng As Excel.Range
Dim vLeft As Variant, vTop As Variant
Dim sURL As String

Const sRootURL As String = "https://quickchart.io/qr?text="

    If Updateable = False Then
        URL_QRCode_SERIES = "outdated"
        Exit Function
    End If
    
    PictureName = "QR-Code_" & DisplayText 'Application.Caller.Address
    Set oRng = Application.Caller
    On Error Resume Next
    Set oPic = oRng.Parent.Shapes(PictureName)
    If Err Then
        Err.Clear
        vLeft = oRng.Left + 4
        vTop = oRng.Top
    Else
        vLeft = oPic.Left
        vTop = oPic.Top
        PictureSize = Int(oPic.Width)
        oPic.Delete
    End If
    On Error GoTo 0
    
    If Len(QR_Value) = 0 Then
        URL_QRCode_SERIES = CVErr(xlErrValue)
        Exit Function
    End If
    
    sURL = sRootURL & WorksheetFunction.EncodeURL(QR_Value)
    
    Set oPic = oRng.Parent.Shapes.AddPicture(sURL, True, True, vLeft, vTop, PictureSize, PictureSize)
    oPic.Name = PictureName
    URL_QRCode_SERIES = DisplayText
End Function

crackerwood · 29 Avril 2025

Bonjour.
Encore merci car tout fonctionne correctement.
Juste une question : vous n'avez changé que l'url c'est bien ça ?
Je me permet de demander (mais sans me faire un code) comment ajouter aux noms des images le contenue d'une cellule.
J'ai modifié cette ligne

VB:

PictureName = "QR-Code_" & DisplayText

en

VB:

PictureName = "QR-Code_" & DisplayText & "_" & activecell.offset(0,5).value

pour récupérer le texte de la cellule E mais cela ne marche pas. Pas de bug mais juste ça ne fonctionne pas. Je pense que ma commande n'est pas bonne.

Dans tout les cas la partie QRCode fonctionne parfaitement et encore merci pour cette partie

fanch55 · 29 Avril 2025

Le contenu est representé par Displaytext, si vous voulez l'adresse de la cellule, il faut modifier la fonction. Je suis en pétanque actuellement, je vous fait cela ce soir

fanch55 · 29 Avril 2025

crackerwood à dit:
Juste une question : vous n'avez changé que l'url c'est bien ça ?

Non, j'utilise également la fonction intégrée EncodeUrl au lieu de celle du module

fanch55 · 29 Avril 2025

crackerwood à dit:
Bonjour.
Encore merci car tout fonctionne correctement.
Juste une question : vous n'avez changé que l'url c'est bien ça ?
Je me permet de demander (mais sans me faire un code) comment ajouter aux noms des images le contenue d'une cellule.
J'ai modifié cette ligne

VB:

PictureName = "QR-Code_" & DisplayText

en

VB:

PictureName = "QR-Code_" & DisplayText & "_" & activecell.offset(0,5).value

pour récupérer le texte de la cellule E mais cela ne marche pas. Pas de bug mais juste ça ne fonctionne pas. Je pense que ma commande n'est pas bonne.

Dans tout les cas la partie QRCode fonctionne parfaitement et encore merci pour cette partie

Pouvez-vous me donner un exemple du texte que vous voulez avoir sous le QrCode ?

crackerwood · 29 Avril 2025

fanch55 à dit:
Pouvez-vous me donner un exemple du texte que vous voulez avoir sous le QrCode ?

Pour faire simple mon tableau fais 3 colonne
B pour la référence
C pour les données pro (nom prénom)
D la colonne qui contient le QRCode

Lors d'une sauvegarde d'image son nom est QR-Code_+colonne référence. Je voudrais avoir en plus la colonne C qui contient les données pro.
Ex pour moi QR-Code_+réf_+données pro.

fanch55 · 29 Avril 2025

crackerwood à dit:
Pour faire simple mon tableau fais 3 colonne
B pour la référence
C pour les données pro (nom prénom)
D la colonne qui contient le QRCode

Lors d'une sauvegarde d'image son nom est QR-Code_+colonne référence. Je voudrais avoir en plus la colonne C qui contient les données pro.
Ex pour moi QR-Code_+réf_+données pro.

Ok, dans le classeur exemple fourni, changez les formules des colonnes F par

VB:

=URL_QRCode_SERIES(E2;80;"Qr-Code_"&A2&"_"&B2&"_"&C2)

Ce qui affichera:

crackerwood · 29 Avril 2025

fanch55 à dit:
Ok, dans le classeur exemple fourni, changez les formules des colonnes F par

VB:

=URL_QRCode_SERIES(E2;80;"Qr-Code_"&A2&"_"&B2&"_"&C2)

Ce qui affichera:
Regarde la pièce jointe 1217165

Merci beaucoup. Je test ça dès que je peux mais j'ai pas de doute sur le bon fonctionnement. Je vous le dirais tout de même.

EDIT : Cela fonctionne très bien (j'ai adapté pour moi mais nickel) par contre quand je fais créer les images il me double tous avec juste la référence et avec la correction que vous avez apporté

Correction : c'est moi qui est fais une fausse manipulation. Cela fonctionne parfaitement.
Encore merci pour avoir pris le temps d'avoir travailler sur mon fichier

fanch55 · 29 Avril 2025

Re-Bonsoir,
Si vous aviez des images en double, vous aviez les mêmes dommages collatéraux que moi .
La fonction avec son codage d'origine ne supporte pas le changement de nom.

Code corrigé :

VB:

Function URL_QRCode_SERIES( _
    ByVal QR_Value As String, _
    Optional ByVal PictureSize As Long = 100, _
    Optional ByVal DisplayText As String = "QRCode >>", _
    Optional ByVal Updateable As Boolean = True) As Variant

Dim PictureName As String
Dim Img As Shape, oRng As Excel.Range
Dim vLeft As Long, vTop As Long
Dim sURL As String

Const sRootURL As String = "https://quickchart.io/qr?text="

    If Updateable = False Then
        URL_QRCode_SERIES = "outdated"
        Exit Function
    End If
    
    On Error Resume Next
        Set oRng = Application.Caller
        For Each Img In oRng.Parent.Shapes
            If Img.TopLeftCell.Address = oRng.Address Then
                vLeft = oRng.Left + 2
                 vTop = oRng.Top + 2
                Img.Delete
            End If
        Next
    On Error GoTo 0
    
    If Len(QR_Value) = 0 Then
        URL_QRCode_SERIES = CVErr(xlErrValue)
        Exit Function
    End If
    
    sURL = sRootURL & WorksheetFunction.EncodeURL(QR_Value)
    Set Img = oRng.Parent.Shapes.AddPicture(sURL, True, True, vLeft, vTop, PictureSize, PictureSize)
    Img.Name = DisplayText
    URL_QRCode_SERIES = DisplayText
    
End Function

crackerwood · 30 Avril 2025

fanch55 à dit:
Ok, dans le classeur exemple fourni, changez les formules des colonnes F par

VB:

=URL_QRCode_SERIES(E2;80;"Qr-Code_"&A2&"_"&B2&"_"&C2)

Ce qui affichera:
Regarde la pièce jointe 1217165

Merci beaucoup. Je test ça dès que je peux mais j'ai pas de doute sur le bon fonctionnement. Je vous le dirais

fanch55 à dit:

Re-Bonsoir,
Si vous aviez des images en double, vous aviez les mêmes dommages collatéraux que moi .
La fonction avec son codage d'origine ne supporte pas le changement de nom.

Code corrigé :

VB:

Function URL_QRCode_SERIES( _
    ByVal QR_Value As String, _
    Optional ByVal PictureSize As Long = 100, _
    Optional ByVal DisplayText As String = "QRCode >>", _
    Optional ByVal Updateable As Boolean = True) As Variant

Dim PictureName As String
Dim Img As Shape, oRng As Excel.Range
Dim vLeft As Long, vTop As Long
Dim sURL As String

Const sRootURL As String = "https://quickchart.io/qr?text="

    If Updateable = False Then
        URL_QRCode_SERIES = "outdated"
        Exit Function
    End If
   
    On Error Resume Next
        Set oRng = Application.Caller
        For Each Img In oRng.Parent.Shapes
            If Img.TopLeftCell.Address = oRng.Address Then
                vLeft = oRng.Left + 2
                 vTop = oRng.Top + 2
                Img.Delete
            End If
        Next
    On Error GoTo 0
   
    If Len(QR_Value) = 0 Then
        URL_QRCode_SERIES = CVErr(xlErrValue)
        Exit Function
    End If
   
    sURL = sRootURL & WorksheetFunction.EncodeURL(QR_Value)
    Set Img = oRng.Parent.Shapes.AddPicture(sURL, True, True, vLeft, vTop, PictureSize, PictureSize)
    Img.Name = DisplayText
    URL_QRCode_SERIES = DisplayText
   
End Function

Problème résolu. Je n'ai plus de souci chez moi donc je pense que là on peut dire grand merci pour votre aide.

fanch55 · 30 Avril 2025

Vérifiez quand même les objets de votre feuille :

crackerwood · 30 Avril 2025

fanch55 à dit:
Vérifiez quand même les objets de votre feuille :
Regarde la pièce jointe 1217177

Oui oui c'est de cette façon que j'ai vu qu'il y avait plus d'images que nécessaire la première fois 🙂

XL 2016 QRcode HS [Résolu]

crackerwood

XLDnaute Nouveau

Pièces jointes

fanch55

XLDnaute Barbatruc

crackerwood

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

crackerwood

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

crackerwood

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

crackerwood

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

crackerwood

XLDnaute Nouveau

Discussions similaires

XL 2016 QRcode HS [Résolu]

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency