génération de QR Code

**marsupilami34** · 15/06/2023, 17h19

Bonjour à tous,

J'ai trouvé sur différent forum comment généré un QR Code et ca fonctionne plutot pas mal.
Voici le code que j'utilise

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
 
Sub setQR(Rg1 As String, qr As String)
'Updated by Extendoffice 2018/8/22
    Dim xSRg As Range
    Dim xRRg As Range
    Dim xObjOLE As OLEObject
    On Error Resume Next
    'Set xSRg = Range(Rg1)
    'Set xSRg = Application.InputBox("Please select the cell you will create QR code based on", "Kutools for Excel", , , , , , 8)
    'If xSRg Is Nothing Then Exit Sub
    'Set xRRg = Application.InputBox("Select a cell to place the QR code", "Kutools for Excel", , , , , , 8)
    'If xRRg Is Nothing Then Exit Sub
    Set xRRg = Range(Rg1)
    Application.ScreenUpdating = False
    Set xObjOLE = ActiveSheet.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
    xObjOLE.Object.Style = 11
    xObjOLE.Object.Value = qr
    ActiveSheet.Shapes.Item(xObjOLE.Name).Copy
    ActiveSheet.Paste xRRg
    xObjOLE.Delete
    Application.ScreenUpdating = True
End Sub

Jutilse cette fonction avec comme paramètre le range (variable Rg1) où je souhaite que mon QR code commence ainsi que le texte que contient mon QR Code (variable qr)

En fait, lorsqu'une cellule de l'excel change, ca appelle la fonction et met à jour mon qr code

Par contre au niveau de l'affichage ca fait un truc bizarre. Lorsque je me modifie successivement mes cellules le QR code se modifie mais ne remplace pas l'ancien. Et pire, il ne met pas par dessus mais en décallé (voir image ci dessous)
Nom : Capture d’écran 2023-06-15 171617.jpg
Affichages : 1283
Taille : 39,8 Ko

Nom : Capture d’écran 2023-06-15 171617.jpg
Affichages : 1283
Taille : 39,8 Ko

En plus de cela, je n'ai pas du tout accès au QR code pour le déplacer ou le supprimer

Sauriez vous résoudre mon problème ?

Par avance merci

Cdlt

Marsup

**binarygirl** · 15/06/2023, 19h04

A tout hasard:
C'est sûr que Application.ScreenUpdating = True est toujours exécuté ?
Ça me dérange un peu de voir On Error Resume Next car ça revient à masquer les erreurs. Pour débugger, je conseillerais de faire sauter cette ligne.

**jurassic pork** · 16/06/2023, 09h07

Hello,
A noter qu'en utilisant l' API google chart on peut générer son QRCode par cette API ( voir ici)
Code à mettre 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

Code à mettre dans le VBA de la feuille où l'on affiche le QRCode dans un activeX Image ( le code ici fonctionne sur changement de sélection) :

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Target.Value = "" Then
    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=" & Target.Value
    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
    Image1.Picture = LoadPicture(strFile)
    Kill strFile
End If
End Sub

Nom : QrCodeGoogleApis.gif
Affichages : 1261
Taille : 38,0 Ko

Les avantages :
Cela permet de ne pas utiliser d'activex externe
Les inconvénients:
Nécessite une liaison internet permanente.
Il peut y avoir des temps de latence dans l'obtention du QRCode.
Dépend de l'API google chart qui peut changer de statut ou disparaitre.
Statut actuel :

Les outils de création de graphiques Google sont performants, simples à utiliser et offerts.

Ami calmant, J.P

**marsupilami34** · 16/06/2023, 09h48

Bonjour et merci à tous pour votre aide.

Au final j'ai créer l'objet QR code dans lequel je viens changer sa valeur lors d'un changement de cellule.
Comme ca, je n'ai pas a créer systématique un nouvel objet

Cdlt

**jakboregar** · 13/11/2023, 19h32

bonjour j'ai un petit probleme avec le code, message "doit être mis à jour pour compatibilité avec systèmes 64 bits, ... mettez à jour les instructions declare puis marquez les avec l'attribut PtrSafe", mais je ne sais pas comment faire, je n'ai pas pu tester la routine selectionchange du coup

merci de m'aider

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

Ami calmant, J.P[/QUOTE]

**jurassic pork** · 13/11/2023, 20h14

Hello,
A essayer :

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
26
27
#If VBA7 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
      Alias "URLDownloadToFileA" ( _
        ByVal pCaller As LongPtr, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As Long, _
        ByVal lpfnCB As LongPtr _
      ) As Long
    Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
      Alias "DeleteUrlCacheEntryA" ( _
        ByVal lpszUrlName As String _
      ) As Long
#Else
    Private 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
    Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
      Alias "DeleteUrlCacheEntryA" ( _
        ByVal lpszUrlName As String _
      ) As Long
#End If

Ami calmant, J.P

**jakboregar** · 13/11/2023, 20h33

C'est mieux, merci beaucoup, mais maintenant dans la routine de la feuille j'ai le message "sub ou fonction n'existe pas" pour ret = URLDownloadToFile(0, strURL, strFile, 0, 0)

j'ai bien copié les déclarations dans un module, pas de signalement d'erreur

ça risque d'être pareil pour deletecache

**jurassic pork** · 14/11/2023, 07h32

Hello,
oops

, il faut mettre les routines en Public et pas en Private sinon on ne les voit que dans le module où elles sont :

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
26
27
#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 Long, _
        ByVal lpfnCB As LongPtr _
      ) As Long
    Public Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
      Alias "DeleteUrlCacheEntryA" ( _
        ByVal lpszUrlName As String _
      ) 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
    Public Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
      Alias "DeleteUrlCacheEntryA" ( _
        ByVal lpszUrlName As String _
      ) As Long
#End If

Ami calmant, J.P

**jakboregar** · 14/11/2023, 11h53

super merci, j'aurai dû y penser
comme je ne suis pas cador VBA j'ai encore un souci avec image1.picture = (...) message objet requis
j'ai essayé de nommer une cellule "image1", ou de placer une image appelée image1, sans succès
désolé du dérangement
gilles

**jurassic pork** · 14/11/2023, 15h54

Envoyé par jakboregar

comme je ne suis pas cador VBA j'ai encore un souci avec image1.picture = (...) message objet requis
j'ai essayé de nommer une cellule "image1", ou de placer une image appelée image1, sans succès
désolé du dérangement
gilles

Il faut insérer un contrôle ActiveX Image dans sa feuille :
Développeur/Mode Création
Développeur/Insérer/Contrôle Activex/Image
Si c'est le premier contrôle ActiveX Image inséré dans la feuille il s'appellera image1

**jakboregar** · 17/11/2023, 18h05

Envoyé par jurassic pork

Il faut insérer un contrôle ActiveX Image dans sa feuille :
Développeur/Mode Création
Développeur/Insérer/Contrôle Activex/Image
Si c'est le premier contrôle ActiveX Image inséré dans la feuille il s'appellera image1

super merci
j'ai paramétré autosize ! comme ça plus d'image tronquée
j'ai créé une image blanche pour effacer le QRcode si besoin, mais il y apeut être un autre moyen
en tous cas merci bien du temps consacré à mes questions

**marsupilami34** · 25/06/2024, 08h05

Envoyé par jurassic pork

Hello,
oops

, il faut mettre les routines en Public et pas en Private sinon on ne les voit que dans le module où elles sont :

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
26
27
#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 Long, _
        ByVal lpfnCB As LongPtr _
      ) As Long
    Public Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
      Alias "DeleteUrlCacheEntryA" ( _
        ByVal lpszUrlName As String _
      ) 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
    Public Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
      Alias "DeleteUrlCacheEntryA" ( _
        ByVal lpszUrlName As String _
      ) As Long
#End If

Ami calmant, J.P

Bonjour à tous,

Je me permets de revenir sur cette discussion, car j'ai essayé ce générer un qr code avec cette méthode.

Le souci c'est que quand je veux ouvrir l'image j'ai l'erreur suivant: "il semble que nous ne prenions pas en charge ce type de fichier".

Quelqu'un saurait pourquoi ?

Merci d'avance

Marsup

**jurassic pork** · 25/06/2024, 14h09

Hello,
va voir ici . Dans le classeur téléchargeable , il y a une fonction personnalisée (URL_QRCode_SERIES) pour afficher un QRCODE dans une cellule. Moi je n'arrive plus à faire fonctionner le code de mes messages précédents

Google has deprecated and retired the chart API.

Ami calmant, J.P

génération de QR Code

Macros et VBA Excel

Discussions similaires

Partager

Partager