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