XL 2016 QRcode HS [Résolu]

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

crackerwood

XLDnaute Nouveau
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.
 

Pièces jointes

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
 
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
 
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 ?
 
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.
 
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:
1745946071340.png
 
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
 
Dernière édition:
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
 
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
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.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
125
Affichages
13 K
Retour