code VBA Générer UN QRCODE

yohan60

XLDnaute Nouveau
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.
 

patricktoulon

XLDnaute Barbatruc
bonjour
perso j'ai suivi a la lettre et quand je veux enregistrer le controls perso Windows me le refuse
que ce soit pour le 64 ou le 32
demo6.gif


j'ai essayer de l'enregistrer avec cmd en administrator aussi et pareil
 

fhoest

XLDnaute Accro
Bonjour à tous.
Je dois avoir un petit peu de chance.
Pour info après le téléchargement j'ai laissé le chemin par défaut et juste dézipper.
Ensuite j'ai installé l ocx.
J'espère que c'est la solution car je n'ai pas d'explication.
A+
 

dysorthographie

XLDnaute Accro
Bonjour,
VB:
Public Function DownloadHTTP(ByVal URL As String, ByVal Destination As String) As Boolean
   On Error GoTo catch
   Dim oWinHTTP As Object
   Dim fic As Integer
   Dim buffer() As Byte

   Set oWinHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
   oWinHTTP.Open "GET", URL, False
   oWinHTTP.send

   If oWinHTTP.Status = 200 Then
      fic = FreeFile
      Open Destination For Binary Lock Read Write As #fic
      buffer = oWinHTTP.ResponseBody
      Put #fic, , buffer

      Close #fic
      DownloadHTTP = True
   Else
      MsgBox "Statut retourné par le service : " & oWinHTTP.Status & vbCrLf & _
             "Description : " & oWinHTTP.StatusText, vbExclamation, "DownloadHTTP()..."
   End If

finally:
   Erase buffer
   Set oWinHTTP = Nothing
   Exit Function
catch:
   MsgBox "Erreur n°" & Err.Number & vbCrLf & "Description : " & Err.Description, vbExclamation, "DownloadHTTP()..."
   Close   'ferme tous les descripteurs ouverts
  Resume finally
End Function

Sub Test()
Debug.Print DownloadHTTP("http://qrickit.com/api/qr?d=Créer dynamiquement des QR Codes en image...&addtext=Test&txtcolor=fb660a&fgdcolor=fb660a&bgdcolor=000000&qrsize=300&t=p&e=m", ThisWorkbook.Path & "\QRCode.png")

End Sub
 

patricktoulon

XLDnaute Barbatruc
salut robert
c'est pas bon !!!! désolé meme en changeant de mot le qrcode reste le même

VB:
Sub Test()
    mots = Array("ChTi160", "Dyshortographie", "patricktoulon")
    For i = 0 To UBound(mots)
        chemin = Environ("userprofile") & "\DeskTop\" & mots(i) & "QRCode.png"
        Debug.Print DownloadHTTP("http://qrickit.com/api/qr?d=Créer dynamiquement des QR Codes en image...&addtext=" & mots(i) & "&txtcolor=fb660a&fgdcolor=fb660a&bgdcolor=000000&qrsize=300&t=p&e=m", chemin)
        Debug.Print "http://qrickit.com/api/qr?d=Créer dynamiquement des QR Codes en image...&addtext=" & mots(i) & "&txtcolor=fb660a&fgdcolor=fb660a&bgdcolor=000000&qrsize=300&t=p&e=m", chemin
    Next
End Sub

comparer les 3 images après se sont les mêmes
 
Dernière édition:

dysorthographie

XLDnaute Accro
Bonsoir Patrick,
VB:
Sub Test()
    mots = Array("ChTi160", "Dyshortographie", "patricktoulon")
    For i = 0 To UBound(mots)
        chemin = Environ("userprofile") & "\DeskTop\" & mots(i) & ".png"
        Debug.Print DownloadHTTP("http://qrickit.com/api/qr?d=" & mots(i) & "&addtext=" & mots(i) & "&txtcolor=fb660a&fgdcolor=fb660a&bgdcolor=000000&qrsize=300&t=p&e=m", chemin)
        Debug.Print "http://qrickit.com/api/qr?d=Créer dynamiquement des QR Codes en image...&addtext=" & mots(i) & "&txtcolor=fb660a&fgdcolor=fb660a&bgdcolor=000000&qrsize=300&t=p&e=m", chemin
    Next
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
315 118
Messages
2 116 424
Membres
112 745
dernier inscrit
mcanas