Insérer un QRcode dans un Userform

Version imprimable

Voir 40 message(s) de cette discussion en une page

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:

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

1 pièce(s) jointe(s)

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:

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:

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

Pièce jointe 630569

Ami calmant, J.P

12/12/2022, 16h13
deedolith

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:

Image1.Picture = LoadPicture("c:\................")
12/12/2022, 16h19
mimic44

Merci beaucoup !!
j'essaie ça de suite par contre je comprends pas le If sur VBA7 ?
12/12/2022, 16h28
jurassic pork

Citation:

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.

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

Code:

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

12/12/2022, 16h39
jurassic pork

Citation:

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 :mrgreen:

1 pièce(s) jointe(s)

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

Pièce jointe 630640

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

Code:

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

13/12/2022, 14h12
mimic44

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 ?
13/12/2022, 14h51
jurassic pork

Il faut choisir la bonne option dans la propriété PictureSizeMode du contrôle Image
14/12/2022, 07h34
mimic44

Oui j'avais vu entre temps, Merci

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

Je les signal donc cette discussion comme résolue.

Bonne journée
15/06/2023, 22h12
Fross_73

2 pièce(s) jointe(s)

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.

Pièce jointe 640147

Pièce jointe 640148
16/06/2023, 07h52
mimic44

Citation:

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.

Pièce jointe 640147

Pièce jointe 640148

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
16/06/2023, 08h14
Fross_73

Bonjour mimic44,

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

Meilleures salutations
16/06/2023, 08h24
mimic44

Citation:

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 ?
16/06/2023, 08h29
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 et que la chaîne dont on demande le QRCode soit valide (faire un essai avec exemple).
Ami calmant, J.P
16/06/2023, 08h30
mimic44

Citation:

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
16/06/2023, 14h04
Fross_73

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
18/06/2023, 13h08
Fross_73

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
18/06/2023, 14h51
jurassic pork

Hello,

Citation:

Envoyé par Fross_73

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

Dans ce cas il faut choisir un autre répertoire qui lui a des droits en écriture pour l'utilisateur.

Ami calmant, J.P

Voir 40 message(s) de cette discussion en une page