Insérer un QRcode dans un Userform

**mimic44** · 12/12/2022, 11h28

Bonjour à tous,

j'ai eu beau chercher, je ne trouve pas de réponse, peut être pourrez vous éclairez ma lanterne.

Voilà ma demande:

Depuis quelques temps j'utilise le code suivant pour générer un QrCode et l'insérer dans une shape dans une feuille excel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
 
donnee = "http://api.qrserver.com/v1/create-qr-code/?data=" & codeAécrire & "&size=250x250" 'Création QRCode sur internet
 
Sheets("OT").Shapes("Image1").Fill.UserPicture (donnee) 'insère l'image dans la forme Image 1

Maintenant je cherche à faire la même chose mais à l'insérer dans un userform et je n'y arrive pas, avez vous une solution ?

Merci

**jurassic pork** · 12/12/2022, 16h11

Hello,
pour générer un qrcode et l'afficher on peut aussi utiliser l'API google Chart.
Voici un exemple qui télécharge le QrCode généré par l' API google Chart en format gif dans un fichier temporaire et qui l'affiche dans un contrôle image de formulaire.
1 - Il faut déclarer l'API windows qui permet de télécharger des fichiers dans un module VBA :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
#If VBA7 Then
    Public Declare Function URLDownloadToFile Lib "urlmon" _
                             Alias "URLDownloadToFileA" ( _
                             ByVal pCaller As LongPtr, _
                             ByVal szURL As String, _
                             ByVal szFileName As String, _
                             ByVal dwReserved As LongPtr, _
                             ByVal lpfnCB As LongPtr) _
                             As Long
#Else
    Public Declare Function URLDownloadToFile Lib "urlmon" _
                             Alias "URLDownloadToFileA" ( _
                             ByVal pCaller As Long, _
                             ByVal szURL As String, _
                             ByVal szFileName As String, _
                             ByVal dwReserved As Long, _
                             ByVal lpfnCB As Long) _
                             As Long
#End If

2 - Voici le code du bouton qui permet d'afficher le QR Code du texte rentré dans le contrôle TextBox1 du formulaire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CommandButton1_Click()
    Dim ret As Long
    Dim strURL As String
    Dim strFile As String
    strURL = "https://chart.googleapis.com/chart?chs=250x250&cht=qr&chof=gif&chl=" & TextBox1.Text
    strFile = "D:\Temp\qrcode.gif"
    ret = URLDownloadToFile(0, strURL, strFile, 0, 0)
    If ret Then
        MsgBox "Failed to download image", vbExclamation
        Exit Sub
    End If
    Me.Image1.Picture = LoadPicture(strFile)
    Kill strFile
End Sub

Nom : QrcodeUF.gif
Affichages : 769
Taille : 38,8 Ko

Ami calmant, J.P

**deedolith** · 12/12/2022, 16h13

Hello,

Dans un UserForm, il te faut charger l'image via la fonction LoadPicture.
Attention, cette fonction ne supporte pas les URL, il te faudra télécharger tes images au préalable.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Image1.Picture = LoadPicture("c:\................")

**mimic44** · 12/12/2022, 16h19

Merci beaucoup !!
j'essaie ça de suite par contre je comprends pas le If sur VBA7 ?

**jurassic pork** · 12/12/2022, 16h28

Envoyé par mimic44

Merci beaucoup !!
j'essaie ça de suite par contre je comprends pas le If sur VBA7 ?

c'est une histoire de compatibilité et pour pouvoir faire fonctionner le code à la fois en 32 bits et 64 bits.

**deedolith** · 12/12/2022, 16h29

@Jurassic pork:
Pourquoi ces horribles API ?
Toutes les libraires dont on a besoin sont installées par défaut:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Explicit
 
Public Function DownloadFile(ByVal Url As String, ByVal SaveTo As String) As Boolean
    Dim WinHttpReq As Object
    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", Url, False
    WinHttpReq.send
 
    If WinHttpReq.Status = 200 Then
        Dim ostream As Object
        Set ostream = CreateObject("ADODB.Stream")
        ostream.Open
        ostream.Type = 1
        ostream.Write WinHttpReq.responseBody
        ostream.SaveToFile SaveTo, 2             ' 1 = no overwrite, 2 = overwrite
        ostream.Close
        DownloadFile = True
    Else
        DownloadFile = False
    End If
End Function
 
Sub test()
    DownloadFile "https://www.developpez.net/template/images/logo-dvp-h55.png", "C:\.......................\file.png"
End Sub

**jurassic pork** · 12/12/2022, 16h39

Envoyé par deedolith

@Jurassic pork:
Pourquoi ces horribles API ?
Toutes les libraires dont on a besoin sont installées par défaut:

Effectivement mais les API sont dans le système et donc aussi disponibles. Elles ne sont pas si horribles que cela

**jurassic pork** · 13/12/2022, 13h54

On peut aussi lire ou écrire un QR Code avec la version interop (objet COM) de zxing.Net :

Nom : zxingInterop.png
Affichages : 748
Taille : 29,0 Ko

Exemple de code pour créer un fichier image QR CODE Png :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub GeneQR()
   Dim writer As IBarcodeWriter
   Dim qrCodeOptions As QrCodeEncodingOptions
   Dim pixelDataResult As PixelData
   Set qrCodeOptions = New QrCodeEncodingOptions
   Set writer = New BarcodeWriter
   writer.Format = BarcodeFormat_QR_CODE
   Set writer.Options = qrCodeOptions
   qrCodeOptions.Height = 250
   qrCodeOptions.Width = 250
   qrCodeOptions.CharacterSet = "UTF-8"
   qrCodeOptions.Margin = 2
   qrCodeOptions.ErrorCorrection = ErrorCorrectionLevel_H
   writer.WriteToFile "Exemple", "D:\temp\interop_qrcode.png", ImageFileFormat_Png
   Rem Or:
   'Set pixelDataResult = writer.Write("Test")
End Sub

**mimic44** · 13/12/2022, 14h12

Bonjour Jurassik Pork,

ça m'embête d'utiliser la library car je ne serai pas le seul a utiliser le fichier et tous le postes n'ont pas les mêmes réf.

Ton premier code fonctionne bien en revanche le Qr code s'affiche plus gros que la l'image dans le userform. comment peut on adapter l'image du QR code pour s'insérer parfaitement dans l'image du Userform ?

**jurassic pork** · 13/12/2022, 14h51

Il faut choisir la bonne option dans la propriété PictureSizeMode du contrôle Image

**mimic44** · 14/12/2022, 07h34

Oui j'avais vu entre temps, Merci

Merci beaucoup pour m'avoir permis de réaliser le userform de mes rêves

Je les signal donc cette discussion comme résolue.

Bonne journée

**Fross_73** · 15/06/2023, 22h12

Bonsoir à tous,

Je commence le codage VBA et je n'arrive pas à comprendre où se trouve l'erreur.

J'ai repris les 2 codes que jurassic pork à mis pour les QRcode mais quand je click sur mon bouton pour générer le qrcode j'ai un message d'erreur qui apparait comme sur l'image si dessous.

J'a contrôlé que mes liens soient correct une bonne soixantaine de fois, essayé de modifier le code mais rien n'y fait.

L'image de mon userform a été renommer en QRCODEIMAGE

Je serais ravis si quelqu'un arrive à trouver mon problème.

Nom : code.png
Affichages : 797
Taille : 23,2 Ko

Nom : code.png
Affichages : 797
Taille : 23,2 Ko

Nom : message erreur.png
Affichages : 790
Taille : 7,8 Ko

**mimic44** · 16/06/2023, 07h52

Envoyé par Fross_73

Bonsoir à tous,

Je commence le codage VBA et je n'arrive pas à comprendre où se trouve l'erreur.

J'ai repris les 2 codes que jurassic pork à mis pour les QRcode mais quand je click sur mon bouton pour générer le qrcode j'ai un message d'erreur qui apparait comme sur l'image si dessous.

J'a contrôlé que mes liens soient correct une bonne soixantaine de fois, essayé de modifier le code mais rien n'y fait.

L'image de mon userform a été renommer en QRCODEIMAGE

Je serais ravis si quelqu'un arrive à trouver mon problème.

Nom : code.png
Affichages : 797
Taille : 23,2 Ko

Bonjour Fross_73,

Visiblement il s'agit d'un problème de chemin d'accès vers ton fichier.

as tu vérifier que le fichier du Qrcode est bien présent sous D:/temp/ ?

cdt

**Fross_73** · 16/06/2023, 08h14

Bonjour mimic44,

Alors j'ai contrôlé et effectivement aucun fichier qrcode ne s'enregistrer dans mon dossier.

Meilleures salutations

**mimic44** · 16/06/2023, 08h24

Envoyé par Fross_73

Bonjour mimic44,

Alors j'ai contrôlé et effectivement aucun fichier qrcode ne s'enregistrer dans mon dossier.

Meilleures salutations

Il faut alors que tu en trouves la cause...

as tu vérifié la variable NUMAFFAIRETBOX.text et à quoi elle renvoi ?

**jurassic pork** · 16/06/2023, 08h29

Hello,
je viens de réessayer mon code, il fonctionne toujours. Il faut que le répertoire où l'on stocke l'image temporaire existe et soit accessible en lecture écriture et que la chaîne dont on demande le QRCode soit valide (faire un essai avec exemple).
Ami calmant, J.P

**mimic44** · 16/06/2023, 08h30

Envoyé par jurassic pork

Hello,
je viens de réessayer mon code, il fonctionne toujours. Il faut que le répertoire où l'on stocke l'image temporaire existe et soit accessible en lecture écriture.
Ami calmant, J.P

Bonjour JP,

oui effectivement il fonctionne bien, je l'utilise toujours.

cdt

**Fross_73** · 16/06/2023, 14h04

Je vais essayer durant le week end d'après les informations que vous m'avez donné et je reviens vers vous.

Merci d'avance

**Fross_73** · 18/06/2023, 13h08

Rebonjour,

J'ai fait un essai avec "exemple" mais rien ne change toujours pas d'image.gif qui s'enregistre dans mon dossier.

J'ai vu que mon dossier est en lecture seule (que je n'arrive pas à enlever) est ce que ça peut venir de ça ?

Quand je click sur le bouton débogage et que mon code est jaune si je vais avec la souris sur la partie me.QRCODEIMAGE.picture un mémo apparaît ou il y a écrit me.QRCODEIMAGE.Picture=Nothing.

Je dois dire que je tourne en rond surtout en sachant que chez vous ça fonctionne sans soucis.

Si vous avez encore des solutions je suis preneur.

Merci d'avance

Meilleures salutations