Discussion :

[mimic44]

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]

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

Ami calmant, J.P

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

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

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

[mimic44]

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

[jurassic pork]

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]

@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]

@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]

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



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]

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 ?

[Fross_73]

Bonjour mimic44,

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

Meilleures salutations

[mimic44]

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]

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]

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]

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]

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

[Fross_73]

Bonjour JP, serait il possible d'avoir votre fichier excel afin que j'essaie chez moi en changeant seulement le dossier ou s'enregistre les image télécharger afin d'être sûr que ce soit vraiment ça le problème.

Merci

Bonne fin de journée

[jurassic pork]

Hello,
en pièce jointe un classeur exemple.
Sinon un répertoire qui est certain d'être en lecture / écriture c'est le répertoire temporaire utilisateur. Pour le connaître :
Dans une invite de commande (cmd.exe) tapez echo %TEMP% :



Ami calmant, J.P

[Fross_73]

Merci pour le fichier,

Je ne sais plus quoi faire, j'ai toujours le même problème même en ayant mis le répertoire comme vous me l'avez dit dans votre dernier message.

Quand j'ouvre le fichier j'ai une erreur qui apparait et je dois changer la déclaration en ajoutant PtrSafe afin que l'erreur disparaisse. Est ce qu'il y aurait un problème de téléchargement ?

Je sais pas si il faut activé quelque chose en plus sur excel ou l'ordinateur pour permettre à excel de télécharger sur internet.

Je suis désolé de vous embêter avec tous ça mais j'ai vraiment pris gout au codage et je ne vais pas abandonner tant que cela ne fonctionne pas

[jurassic pork]

Effectivement si tu es en Excel 64 bits il manque peut-être un PtrSafe dans la déclaration des Apis :

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

Lors de l’exécution dans des versions 64 bits d’Office, les instructions Declare doivent inclure le mot clé PtrSafe . Le mot clé PtrSafe indique que l’instruction Declare peut être exécutée en toute sécurité dans des environnements de développement 64 bits.

[Fross_73]

Alors justement ça j'avais trouvé et mis ptrsafe dans mon code. Je viens d'essayer sur un autre ordinateur et toujours le même soucis. 😅