QR-factures pour la Suisse

Et, après validation par Yvouille auprès de SIX et PostFinance, voici une version python utilisant le code Nayuki.

Image vectorielle => XL2016 mini. Avantage par rapport à la version javascript : ne nécessite pas d'ouvrir un navigateur.

Pour les utilisateurs de la version python précédente, on oublie le dossier PyQRCode-1.2.1

Conditions requises :

• installer python https://www.python.org/downloads/
• noter dans la macro le dossier dans lequel se trouve pythonw.exe (pythonw.exe et non python.exe)
• mettre dans un même dossier le fichier excel et le fichier qrcodegen.py
• un onglet py
• une zone QRValeur
• une zone iciQRCode
• la croix suisse dénommée "croix"

ne pas oublier de mettre à jour en début de macro le chemin vers pythonw.exe, souvent sous cette forme

Const pythonPath = """C:\Users\XXXXXX\AppData\Local\Programs\Python\Python38-32\pythonw.exe"""

Fonctionnement automatique de la macro :

• la macro crée un fichier python temporaire et le lance
• le script python crée un fichier temporaire image vectorielle .svg
• la macro télécharge l'image et repositionne la croix au centre
• elle supprime enfin les fichiers temporaires

code py :

from qrcodegen import *
="qr = QrCode.encode_text('''" & Encode_UTF8(QRValeur) & "''', QrCode.Ecc.MEDIUM)"
txt = (qr.to_svg_str(4))
f = open('myQRCode.svg', 'w')
f.write(txt)
f.closed

code VBA :

' mike steelson
' https://forum.excel-pratique.com/excel/qr-factures-pour-la-suisse-105696

Option Explicit
Const pythonPath = """C:\Users\Michel\AppData\Local\Programs\Python\Python38-32\pythonw.exe"""

Sub ProduireQRCode()
Dim i%, xq%, yq%, wq%, hq%, ff%

    ChDir ThisWorkbook.Path

    On Error Resume Next
        ' effacement de l'image et des fichiers le cas échéant
        ActiveSheet.Shapes.Range(Array("myQRCode")).Delete
        Kill "myQRCode.py"
        Kill "myQRCode.svg"
    On Error GoTo 0

    ' écriture fichier python
    Close #1
    ff = FreeFile
    Open "myQRCode.py" For Output As #ff
    With Sheets("py")
        For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
            Print #ff, .Cells(i, 1).Value
        Next
    End With
    Close #ff

    Shell (pythonPath & " myQRCode.py")

On Error GoTo messageErreur

    ' lieu de mise en place du QRCode
    With ActiveSheet.Range("iciQRCode")
        yq = .Top - 9: xq = .Left - 9
    End With
    wq = 146: hq = 146

    ' importation de la nouvelle image QRCode
    With ActiveSheet.Pictures.Insert("myQRCode.svg")
        .Width = wq: .Height = hq
        .Left = xq: .Top = yq
        .Name = "myQRCode"
    End With

    ' mise en place de la croix
    With ActiveSheet.Shapes.Range("croix")
        .Left = xq: .Top = yq
        .IncrementLeft (wq - .Width) / 2
        .IncrementTop (hq - .Height) / 2
        .ZOrder msoBringToFront
    End With

    Kill "myQRCode.py"
    Kill "myQRCode.svg"

    Exit Sub

messageErreur:
    'indique le numéro et la description de l'erreur survenue
    MsgBox "Erreur survenue ... " & "#" & vbCrLf & Err.Number & vbLf & Err.Description
    Exit Sub

End Sub

Public Function Encode_UTF8(astr)
    Dim c
    Dim n
    Dim utftext

    utftext = ""
    n = 1
    Do While n <= Len(astr)
        c = AscW(Mid(astr, n, 1))
        If c < 128 Then
            utftext = utftext + Chr(c)
        ElseIf ((c >= 128) And (c < 2048)) Then
            utftext = utftext + Chr(((c \ 64) Or 192))
            utftext = utftext + Chr(((c And 63) Or 128))
        ElseIf ((c >= 2048) And (c < 65536)) Then
            utftext = utftext + Chr(((c \ 4096) Or 224))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        Else ' c >= 65536
            utftext = utftext + Chr(((c \ 262144) Or 240))
            utftext = utftext + Chr(((((c \ 4096) And 63)) Or 128))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        End If
        n = n + 1
    Loop
    Encode_UTF8 = utftext
End Function

Sub dimensionnerCroix()
    With ActiveSheet.Shapes.Range("croix")
        .Width = 19
        .LockAspectRatio = msoFalse
        .Height = 19
        Debug.Print .Width, .Height
    End With
End Sub

Bonjour les experts Suisses,

pourriez vous me dire comment vous auriez résolu le fait de ne pas dupliquer qrcodegen.py dans chaque dossier de chacun des fichiers excel ?

voir demande ici https://forum.excel-pratique.com/excel/swiss-qr-facture-qrcodegen-py-dans-dossier-different-du-fichi...