Office: (Office 2000) QR CODE (2D Barcode) in Bericht

daolix · 8. Januar 2013

Hallo

Zeileumbrüche musst du URL-Like kodieren. In deinem Text mußt du diese durch %0A ersetzen oder gleich entsprechen zusammensetzen

zb.
qr.text = [Rechnungswert] & "%0A" & [RechnungsDatum] & & "%0A" & ....

Katsche · 8. Januar 2013

super, funktioniert *Smilie
Vielen Dank

Katsche · 26. Januar 2013

Hallo daolix, Hallo zusammen,

die Demo-DB von daolix setze ich derzeit erfolgreich bei mir ein jedoch wird der QR-Code vom Typ: URL erzeugt, besteht hier die Möglichkeit auf dem QR-Code Typ: TEXT umzustellen?

Meine Bemühungen im Modul das Wort "URL" gegen "TEXT" auszutauschen haben nicht funktioniert. Ich würde mich freuen wenn mir jemand sagen könnte wo ich was ändern muss.

Gruß,
Katsche

manuel74 · 8. Dezember 2015

Moin zusammen,

ich möchte dieses QR Tool gerne nutzen um damit für eine Kasse Barcodeetiketten zu drucken. Allerdings habe ich zwei Probleme:

Wie muß der Code umgeschrieben werden damit ich Datenfelder aus einem Formular oder einer Abfrage übergebe?

Wenn ich hinter "Data" einen Text mit Sonderzeichen eingebe z.B. "" wird der QR-Code von meiner Scanapp nicht erkannt.

Vorab schon mal vielen Dank!

avogt_at_home · 8. Dezember 2015

Hallo,
Im Aufruf von CopyURLToFile() musst du den Parameter (?data=) besetzen.
Alles was du dahinter schreibst wird zur Erstellung des QR-Codes verwendet.

Andreas

manuel74 · 8. Dezember 2015

Danke für die schnelle Antwort, leider hilft die mir nicht weiter. Wie kann ich an dieser Stelle auf entsprechende Datenfelder in einem Formular oder in einer Abfrage verweisen und warum werden, wenn ich nach Data= einen Text eingebe, keine Sonderzeichen erkannt.

avogt_at_home · 8. Dezember 2015

Hallo,
z.B. in einer Schleife eines Recordsets, über DLookup() etc.
Es geht nur über CODE, eine bindung an Tabelle etc. ist nicht möglich.

Andreas

daolix · 8. Dezember 2015

hallo

bei Sonderzeichen müsstest du ggf deinen text noch URL-codieren (z.B. mittels Api UrlEscape). Bin mir aber nicht sicher.

Datenfelder übergibst du ähnlich
DeinText = [Rechnungswert] & " / " & [RechnungsDatum] & & " / " & ....
Hier sind die eckigen Rechnungswert und Rechnungsdatum die entsprechenden Felder eine(s/r) Formular oder Abfrage, die im diesem Bsp entsprechen in einem String zusammengesetzt werden. diesen übergibst dann, mit den anderen Werten zusammengesetzt, wie von Andreas schon erwähnt der zuständigen Funktion.

Hansol · 16. Januar 2018

Hallo,
wie kann ich den Speicherort der Bilddateien ändern?

Code:

'// ----------------------------------------------------------------------------------------------------------------
'// Original von daolix ( PB-Klasse )
'// Modul : cQrCode
'// Version : 0.0.1
'// Translated : daolix
'// Date : 07..01.2013
'// Last Change : 07..01.2013
'// ----------------------------------------------------------------------------------------------------------------
Option Compare Database
Option Explicit

'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Private Declare Function URLDownloadToFile Lib "urlmon.dll" Alias "URLDownloadToFileW" _
( _
pCaller As Any, _
ByVal lpszURL As Long, _
ByVal lpszFileName As Long, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long _
) As Long

'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Private Const CP_UTF = 65001

'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Private Type RGBColorBytes
R As Byte
g As Byte
b As Byte
a As Byte
End Type

Private Type RGBColorLong
l As Long
End Type

'// ----------------------------------------------------------------------------------------------------------------
'// Instance's
'// ----------------------------------------------------------------------------------------------------------------
Private iText As String
Private iFile As String
Private iSize As Long
Private iForeColor As Long
Private iBackColor As Long
Private iBorderWidth As Integer
Private iQZone As Integer
Private iUseErr As Long
Private iCodePage As Long
Private iCharsetSource As String
Private iCharsetTarget As String
Private iecc As String * 1
Private iPicFormat As String

'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
iSize = 100
iBorderWidth = 3
iQZone = 0
iForeColor = 0
iBackColor = RGB(255, 255, 255)
iCodePage = CP_UTF
'iFile = curdir
iCharsetSource = "UTF-8" 'UTF-8, ISO-8859-1
iCharsetTarget = "UTF-8"
iecc = "H"
iPicFormat = "png"
End Sub

'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Private Function DL_QRCode() As Long
On Error GoTo Sub_Error
Const FuncName = "DL_QRCode"
Const URL$ = "http://api.qrserver.com/v1/create-qr-code/?" '{data}"
If Len(iFile) = 0 Then Err.Raise 32000 + 1, FuncName, "Fileangabe fehlt"
If Len(iText) = 0 Then Err.Raise 32000 + 2, FuncName, "Text fehlt"
Dim sURL As String
Dim cb As RGBColorBytes
Dim cl As RGBColorLong
sURL = URL$ & "data=" & iText
sURL = sURL & IIf(iSize > 19, "&size=" & iSize & "x" & iSize, "")
cl.l = iForeColor: LSet cb = cl: sURL = sURL & "&color=" & cb.R & "-" & cb.g & "-" & cb.b
cl.l = iBackColor: LSet cb = cl: sURL = sURL & "&bgcolor=" & cb.R & "-" & cb.g & "-" & cb.b
sURL = sURL & "&margin=" & Format$(iBorderWidth)
sURL = sURL & "&qzone=" & Format$(iQZone)
sURL = sURL & "&charset-source=" & iCharsetSource
sURL = sURL & "&charset-target=" & iCharsetTarget
sURL = sURL & "&ecc=" & iecc
sURL = sURL & "&format=" & iPicFormat
If URLDownloadToFile(ByVal 0, StrPtr(sURL), StrPtr(iFile), 0, 0) 0 Then Err.Raise 32000 + 3, FuncName, "Download fehlgeschlagen"
Sub_Exit:
DL_QRCode = 1
Exit Function

Sub_Error:
MsgBox Err.Description
Exit Function

End Function

'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Property Get Text() As String: Text = iText: End Property
Property Let Text(ByVal n As String): iText = n: End Property

Property Let GErr(ByVal l As Long): iUseErr = l: End Property

Property Get File() As String: File = iFile: End Property
Property Let File(ByVal in_iFile As String): iFile = in_iFile: End Property

Property Get SIZE() As Long: SIZE = iSize: End Property
Property Let SIZE(ByVal in_iSize As Long): iSize = in_iSize: End Property

Property Get ForeColor() As Long: ForeColor = iForeColor: End Property
Property Let ForeColor(ByVal in_iForeColor As Long): iForeColor = in_iForeColor: End Property

Property Get BackColor() As Long: BackColor = iBackColor: End Property
Property Let BackColor(ByVal in_iBackColor As Long): iBackColor = in_iBackColor: End Property

Property Get BorderWidth() As Integer: BorderWidth = iBorderWidth: End Property
Property Let BorderWidth(ByVal in_iBorderWidth As Integer): iBorderWidth = in_iBorderWidth: End Property

Property Get QZone() As Integer: QZone = iQZone: End Property
Property Let QZone(ByVal in_iQZone As Integer): iQZone = in_iQZone: End Property

'Property Get CodePage() As Long: CodePage = iCodePage: End Property
'Property Let CodePage(ByVal cp As Long): iCodePage = cp: End Property

Property Get CharsetSource() As String: CharsetSource = iCharsetSource: End Property
Property Let CharsetSource(ByVal CS As String): iCharsetSource = CS: End Property

Property Get CharsetTarget() As String: CharsetTarget = iCharsetTarget: End Property
Property Let CharsetTarget(ByVal CS As String): iCharsetTarget = CS: End Property

Property Let ErrorCorrection(ByVal ecc As String): iecc = Left$(ecc, 1): End Property

'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Function Execute() As Long
Execute = DL_QRCode
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hansol · 19. Januar 2018

Kann mir denn wirklich keiner weiter helfen?*frown.gif*

Bin mir sicher das es an
Code:

If URLDownloadToFile(ByVal 0, StrPtr(sURL), StrPtr(iFile), 0, 0) 0 Then Err.Raise 32000 + 3, FuncName, "Download fehlgeschlagen"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Strptr(iFile) hängt.

Aber alle meine Bemühungen den Pfad zu ändern schlugen fehl. Egal was ich gemacht habe es wurde immer in dem Verzeichnis abgelegt von wo aus Access gestartet wurde.

Weiter oben im Quellcode steht noch
Code:

'iFile = curdir
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

aber auch die Aktivierung der Zeile und curdir ersetzt durch "N:/" ging nicht.

Nouba · 19. Januar 2018

Ohne UrlEncodierung arbeitet die Klasse nicht einwandfrei. Sie besitzt aber eine Eigenschaft File - wozu die wohl zu gebrauchen ist? Weiterhin scheint der Service zumindest zum jetzigen Zeitpunkt kostenpflichtig zu sein. Siehe: Unsere Pakete und Preise

Im Anhang findest Du einen UrlEncodierten Beispielcode zur Verwendung der Klasse.

Hansol · 19. Januar 2018

Hab es geschafft!!*mrcool

daolix · 20. Januar 2018

Im Anhang findest Du...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

lol, auf die Idee muss man erst mal kommen.*Smilie

..zum jetzigen Zeitpunkt kostenpflichtig zu sein
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Jup, schaut so aus, vor 5 Jahren glaub ich was das noch nicht. Aber damals wurden auch nur png's zurückgegeben, heute sind's n' paar Formate mehr. Die Klasse ist halt nicht auf den neusten Stand und auch eine Encodierung (Api, ScriptControl, Selbstgeschrieben) fehlt, dat stimmt. Warum die Server-Api aber immer noch für lau funktioniert erschliesst sich mir jetzt nicht.

Office: (Office 2000) QR CODE (2D Barcode) in Bericht

QR CODE (2D Barcode) in Bericht

QR CODE (2D Barcode) in Bericht

QR CODE (2D Barcode) in Bericht

QR CODE (2D Barcode) in Bericht

QR CODE (2D Barcode) in Bericht

QR CODE (2D Barcode) in Bericht - Similar Threads - CODE Barcode Bericht

Code läuft mit F8 durch, beim CommandButon nicht

Code für Zeilensprung auf 125 Ändern

Excel VBA - Code Hilfe (Spalten, Werte kopieren etc.)

VBA Code " Zeilenhöhe bei Verb. Zellen Funktioniert fasst"

PDF mit Namen,Datum speichern im Zielordner

Datentabelle per VBA Makro durch Kopieren und Einfügen einer Kopfzeile aufteilen

VBA Code abändern für Barcodes