2 QR Codes erstellen
26.07.2022 13:31:59
sinan
Ich würde gerne zwei QR Code aus Zelle A18 und A19 erstellen. Dafür habe ich mir folgenden Code aus dem Internet geholt.
In dem ersten Abschnitt wird der QR Code aus Zelle A18 erstellt. Danach überschreibe ich die Variable xSRg mit dem Wert der Zelle A19. Nun sollte eigentlich ein anderer QR Code eingefügt werden. Das Problem ist jedoch, dass der 2. QR Code den selben Inhalt wie der erste hat.
Egal was ich für die Variable eingebe, es tut sich nichts ändern.
Ich hoffe jemand hat eine Lösung für mein Problem.
Dim xSRg As Range
Dim xRRg As Range
Dim xObjOLE As OLEObject
On Error Resume Next
Set xSRg = Range("$A$18")
If xSRg Is Nothing Then Exit Sub
Set xRRg = Range("$H$14")
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 = xSRg.Text
ActiveSheet.Shapes.Item(xObjOLE.Name).Copy
ActiveSheet.Paste xRRg
xObjOLE.Delete
Application.ScreenUpdating = True
'Dim xSRg As Range
'Dim xRRg As Range
'Dim xObjOLE As OLEObject
On Error Resume Next
Set xSRg = Range("$A$19")
If xSRg Is Nothing Then Exit Sub
Set xRRg = Range("$R$14")
If xRRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xObjOLE = ActiveSheet.OLEObjects.Add("BARCODE.BarCodeCtrl.2")
xObjOLE.Object.Style = 11
xObjOLE.Object.Value = xSRg.Text
ActiveSheet.Shapes.Item(xObjOLE.Name).Copy
ActiveSheet.Paste xRRg
xObjOLE.Delete
Application.ScreenUpdating = True