Macro création QR code

Ci dessous vous trouvez mon fichier.

Alban99 a écrit :

Par contre j'ai du mal à trouver à quel moment sur le code que @Steelson a lier la cellule A1 avec la formule de QR Code.

Merci d'avance.

Alban

La liaison entre le QRCode en A2 et la formule en A1 se fait ici

Set oRng = Application.Caller.Offset(, 1)
Set oPic = oRng.Parent.Shapes(PictureName)

oRng = la cellule décalée d'une colonne de la cellule "appelante", dans laquelle viendra se mettre l'image oPic

je vais regarder ton fichier

Alban99 a écrit :

Ci dessous vous trouvez mon fichier.

Il faudrait un peu plus d'explications ...

1. combien de QRCode veux-tu sur ta page,
2. quelles sont les informations portées par le QRCode,
3. quel est le séparateur entre les informations
4. où sera/seront situé(s) le(s) QRcode ?

Bonjour Steelson,

Merci beaucoup de votre réponse.
En effet , je souhaiterai avoir le QR Code sur la cellule C23. Les informations portées par le QR code sont les valeurs de la cellule B23 et B25, le separateur des informations est un "/" ou même un tabulation si c'est possible puisque le code QR va être scanner et les valeurs de ce derniers serons enregistrer sur SAP.

Bien cordialement.

En B24, mets ceci

=URL_QRCode_SERIES("sap"&LIGNE();B25 & CAR(9) & B23)

dans cette version, on commence par donner un nom à l'image (ici ce sera sap et le n° de ligne) puis le contenu, séparé par car(9) qui est la tabulation.

Rebonjour Steelson,

La fonction fonctionne parfaitement.
Merci infiniment pour votre aide.

Bonne journée.

Alban

Bonjour à tous,

je découvre avec le plus intérêt ce forum et vos conseils qui m'ont déjà permis de créer le fichier ci-joint.

Je cherche à éditer en masse des QRCODE code et surtout à les imprimer. Voici un descriptif :

> Les informations codées sont : un nom client, un emplacement, ID d'un poste et son libellé (en jaune dans le tableau)

> Je souhaiterais que l'image du QRCODE reprenne en dessous un logo et au dessus le nom client, nom du poste et emplacement.

Pour l'instant j'utilise une feuille de données et une feuille dans laquelle est générée le QRCODE. Je joue avec la mise en forme des cellules pour faire une sorte de ''masque'' avec le logo en bas et les infos en haut. l'image du QRCODE se génère au milieu. C'est plus parlant dans mon fichier ;-) C'est un peu du bricolage et ce n'est pas fonctionnel car il me reste à résoudre :

> la génération automatique des QRCODE sur la feuille d'impression

> la modification de certaines données et la regénération du QRCODE correspondant

> cerise sur le gâteau que les données et le logo visible en haut et en bas du QRCODE soit générés par une macro.

merci pour votre aide et vos idées.

Bonjour et bienvenue,

regarde de ce côté https://www.excel-pratique.com/fr/telechargements/macros/qr-code-excel-no435

je vais regarder de plus près ton besoin pour adapter

Sans tout casser le code, voici une solution avec 2 formules (un essai en A2 et B2), à dupliquer toutes les 12 lignes

On peut y ajouter une fonction LIGNE et COLONNE pour les avoir toutes ... combien veux-tu de QRCode par ligne ?

Après en effet, on peut passer par une sub pour ne pas avoir à taper les formules

Et voici avec la sub

Sub QRCODES()
Const sRootURL As String = "https://chart.googleapis.com/chart?"
Const sSizeParameter As String = "chs="
Const sTypeChart As String = "cht=qr"
Const sDataParameter As String = "chl="
Const sJoinCHR As String = "&"
Const monlogo = "https://fr.freelogodesign.org/Content/img/logo-samples/flooop.png"

Dim oLogo As Shape, oQR As Shape

    Sheets("sub").Select
    Cells.HorizontalAlignment = xlCenter
    Cells.ClearContents
    For i = 1 To 20 Step 2
        Columns(i).ColumnWidth = 4
        Columns(i + 1).ColumnWidth = 20
    Next
    Dim Img As Object
    For Each Img In ActiveSheet.Pictures
        Img.Delete
    Next Img

    lig = 2: col = 2
    With Sheets("Checkpoints")
        For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
            Cells(lig, col) = .Range("B" & i) & " " & .Range("E" & i)
            vLeft = Cells(lig, col).Left: vTop = Cells(lig, col).Top

            QR_Value = .Range("B" & i) & vbCrLf & .Range("D" & i) & vbCrLf & .Range("E" & i)
            sURL = sRootURL & _
                sSizeParameter & 120 & "x" & 120 & sJoinCHR & _
                sTypeChart & sJoinCHR & _
                sDataParameter & UTF8_URL_Encode(VBA.Replace(QR_Value, " ", "+"))
            Set oQR = Cells(lig, col).Parent.Shapes.AddPicture(sURL, True, True, vLeft, vTop + 16, 118, 120)
            oQR.Name = "QRC" & i

            Set oLogo = Cells(lig, col).Parent.Shapes.AddPicture(monlogo, True, True, vLeft + 4, vTop + 100, 100, 50)
            oLogo.Name = "Logo" & i

            col = col + 2
            If col > 10 Then col = 2: lig = lig + 10
        Next
    End With
End Sub

Function UTF8_URL_Encode(ByVal sStr As String)
    'http://www.nonhostile.com/howto-convert-byte-array-utf8-string-vb6.asp
    Dim i As Long
    Dim a As Long
    Dim res As String
    Dim code As String

    res = ""
    For i = 1 To Len(sStr)
        a = AscW(Mid(sStr, i, 1))
        If a < 128 Then
            code = Mid(sStr, i, 1)
        ElseIf ((a > 127) And (a < 2048)) Then
            code = URLEncodeByte(((a \ 64) Or 192))
            code = code & URLEncodeByte(((a And 63) Or 128))
        Else
            code = URLEncodeByte(((a \ 144) Or 234))
            code = code & URLEncodeByte((((a \ 64) And 63) Or 128))
            code = code & URLEncodeByte(((a And 63) Or 128))
        End If
        res = res & code
    Next i
    UTF8_URL_Encode = res
End Function

Private Function URLEncodeByte(val As Integer) As String
    Dim res As String
    res = "%" & Right("0" & Hex(val), 2)
    URLEncodeByte = res
End Function

Bonjour Steelson et merci pour l'intérêt que tu portes à ma problématique.

Ta réponse et tes précédents post m'ont permis de réaliser le fichier ci-joint.

La feuille 2 contient la génération de 4 QRCODE par ligne. Je cherchais à automatiser la génération de ces codes et leur regénération suite à une modification des données de la feuille checkpoint sans que l'utilisateur ait à intervenir dans la feuille où se trouve les QRCODE . J'ai beaucoup transpiré depuis ce matin et je suis parvenu à l'instant via range.calculate à regénérer le QRCODE et les données de la cellule. Et ce qui tient pour moi du miracle....ça fonctionne.

Je vous partage le résultat.

Je joins ma dernière version : 2 feuilles, checkpoint et feuille 2 pour l'impression

Je n'ai cependant pas compris pourquoi l'API ne fonctionne tout le temps. Y a-t-il une limitation ?

Je n'avais pas vu ton retour. Merci de ta rapidité, j'y regarde de plus près

Ce sera sans doute mieux in fine et plus facilement maintenable.

Avec range.calculate tu multiplies peut-être les appels à l'API.

Mazarin13 a écrit :

Je n'ai cependant pas compris pourquoi l'API ne fonctionne tout le temps. Y a-t-il une limitation ?

Je ne pense pas qu'il y en ait aujourd'hui, mais il faut s'y préparer si google fait comme pour google map ! https://forum.excel-pratique.com/excel/qr-factures-pour-la-suisse-105696/3#p892296

Je reviens sur la solution function avec une seule formule