code VBA Générer UN QRCODE

yohan60 · 14 Octobre 2020

Bonjour à tous,

je souhaiterais générer via un bouton un qrcode depuis les informations (nom, prénom, société etc) d'un tableau excel via un code VBA, Puis une fois le qrcode générer et imprimer sur un support style (badge, téléphone) scanner ce support, et réinsérer de manière automatique dans un autre tableaux, le 1er tableau servirais de base de données.

quelqu'un peux me dire si cela est possible.
j'espère avoir été simple et claire.
a bientôt.

kiki29 · 14 Octobre 2020

Salut, voir ici

Rhysand · 14 Octobre 2020

Bonjour à tous,

regarde ce lien https://www.extendoffice.com/documents/excel/5404-excel-create-qr-code.html

yohan60 · 14 Octobre 2020

kiki29 à dit:
Salut, voir ici

bonjour, je regarde et vous tient au courant, merci

yohan60 · 14 Octobre 2020

Rhysand à dit:
Bonjour à tous,

regarde ce lien https://www.extendoffice.com/documents/excel/5404-excel-create-qr-code.html

bonjour, je regarde et vous tient au courant, merci

yohan60 · 14 Octobre 2020

Re,

j'ai teste mais je n'y arrivent pas, a générer le qrcode

fhoest · 14 Octobre 2020

Bonjour,
normalement ça fonctionne, est ce que l'ocx a été installé ?
comme dans le lien de Rhysand

Ensuite on peut mettre le code aussi comme cela:

Code:

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

Je n'invente rien tout est dans l'exemple du lien.
A bientôt.

ChTi160 · 14 Octobre 2020

Bonsoir le Fil
j'ai installé les Ocx
mais rien pas de QR Code si on enlève le On Error il me met Erreur 400
Aller LENS lol
jean marie

fhoest · 14 Octobre 2020

Bonsoir,
@ChTi160, l'application Excel a t elle été fermé au préalable ! et exécuté en Mode Admin ?
si oui , je n'ai pas d'idée chez moi ça fonctionne, sauf peut être de supporter la bonne équipe et hop le code bar fonctionne lol...
que le meilleur gagne, mais ça fait plaisir de revoir Lens en Ligue 1.
A bientôt.

yohan60 · 14 Octobre 2020

fhoest à dit:

Bonjour,
normalement ça fonctionne, est ce que l'ocx a été installé ?
comme dans le lien de Rhysand
Regarde la pièce jointe 1081544

Ensuite on peut mettre le code aussi comme cela:

Code:

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

Je n'invente rien tout est dans l'exemple du lien.
A bientôt.

bsr, je n'arrivent pas à installer les OCX, Comment ont fait svp.je suis pas un expert

fhoest · 14 Octobre 2020

Bonsoir,
1° Télécharger l'ocx. (https://download.extendoffice.com/downloads/other/Controls/MSBCODE.zip)
2° Fermer Excel
3° Ouvrir Excel en Mode Administrateur
4°Allez a l'onglet Developpeur, puis cliquez sur le tournevis et la clé.
5° Enregistrer le contrôle personnalisé.
6° Recherche de L'ocx puis OK
7° Refermer Excel
8° Réouvrir Excel et tester.
9° Supporter le Losc (dédicace au Chti160)

En espérant aider.

ChTi160 · 15 Octobre 2020

Bonjour !
Bon j'avance "Impossible d'insérer un Object " Lol (sans On Error )
et je fais quoi ? Lol
ou alors ca me copie la procédure dans la cellule cible.
Aller Lille!
jean marie

fhoest · 15 Octobre 2020

Bonjour,
Ca avance.
Est ce que le contrôle apparaît dans la liste des objets.
Si oui je propose de faire un test sans le code d'insertion de ce dernier, puis ensuite recommencer avec le code.
Je vais continuer à chercher de mon côté.
Mais ça vient bon car je vois "Allez Lille".
A+

ChTi160 · 15 Octobre 2020

Re
oui il apparait bien !
merci de l'intérêt que tu portes a ma demande !
jean marie

ChTi160 · 15 Octobre 2020

Autre vidéo
j'essaie de mettre manuellement un Object CodeBarre dans la Feuille .
Voir le Nom du Control dans la barre des formules "

"BARCODE.BarCodeCtrl.1";"")
y'a ";"" en fin de Nom

jean marie

code VBA Générer UN QRCODE

yohan60

XLDnaute Nouveau

kiki29

XLDnaute Barbatruc

Rhysand

XLDnaute Junior

yohan60

XLDnaute Nouveau

yohan60

XLDnaute Nouveau

yohan60

XLDnaute Nouveau

Pièces jointes

fhoest

XLDnaute Accro

ChTi160

XLDnaute Barbatruc

fhoest

XLDnaute Accro

yohan60

XLDnaute Nouveau

Pièces jointes

fhoest

XLDnaute Accro

ChTi160

XLDnaute Barbatruc

Pièces jointes

fhoest

XLDnaute Accro

ChTi160

XLDnaute Barbatruc

Pièces jointes

ChTi160

XLDnaute Barbatruc

Pièces jointes

Discussions similaires