QR Code erstellen

Hallo zusammen,

ich benötige eure Hilfe, ich komme leider nicht mehr weiter.
Ich habe einen Code erstellt, der mit ein QR-Code erstellt. Ich möchte den Inhalt in Zelle A1 umgewandelt haben in QR-Code und dies in Zelle D1.
Das ganze geht immer weiter A2 in D2 usw. Das ganze läuft, aber sobald es in zweite Zeile geht und den QR-Code erstellen will, kommt diese Fehlermeldung:
"Laufzeitfehler 438; Objekt unterstützt diese Eigenschaft oder Methode nicht".

Wenn ich Debuggen, komme ich in diese Zeile:





Sub QRCode_Edit(ZielRange As Range)

    Selection.ShapeRange.LockAspectRatio = msoFalse

    Selection.ShapeRange.ScaleWidth 0.1651126718, msoFalse, msoScaleFromTopLeft

    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 454

    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 97

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 189

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 0

    Selection.ShapeRange.LockAspectRatio = msoFalse

    Selection.ShapeRange.IncrementTop 7.0587401575

    Selection.ShapeRange.ScaleHeight 0.9276018575, msoFalse, msoScaleFromTopLeft

    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 454

    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 97

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 189

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -3

    Selection.ShapeRange.LockAspectRatio = msoFalse

    Selection.ShapeRange.IncrementLeft 8.8234645669

    Selection.ShapeRange.ScaleWidth 0.8823538058, msoFalse, msoScaleFromTopLeft

    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 454

    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 97

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 185

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -3

    Selection.ShapeRange.LockAspectRatio = msoFalse

    Selection.ShapeRange.IncrementTop 0.00007874015748

    Selection.ShapeRange.ScaleHeight 0.7317079966, msoFalse, msoScaleFromTopLeft

    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 454

    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 97

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 185

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 8

    'Größe ändern

    Selection.ShapeRange.LockAspectRatio = msoTrue

    Selection.ShapeRange.ScaleHeight 1.9, msoFalse, msoScaleFromTopLeft

    'Zentrieren

    For Each objShape In Tabelle1.Shapes

        With objShape

            If .Type = msoPicture Then

                .Left = .TopLeftCell.Left + .TopLeftCell.Width / 2 - .Width / 2

                .Top = .TopLeftCell.Top + .TopLeftCell.Height / 2 - .Height / 2

            End If

        End With

    Next

End Sub

Kann mir vielleicht jemand sagen, warum? Hin und wieder führt Excel es sauber aus und manchmal nicht.





Sub QR_erstellenx()

Dim objShape As Shape

Dim ws1 As Worksheet

Dim rowRange As Range

Dim count As Integer

Dim x As String



'QRCode_Create Range("D1"), Range("A1")



'Spalte "D" auf größe Einstellen

    Columns("D:D").Select

    Selection.ColumnWidth = 25.86

    Rows("1:100").Select

    Selection.RowHeight = 165



'Länge der Liste an Sachnummern zählen

'Set ws1 = ThisWorkbook.Worksheets("QR Code")

'Set rowRange = ws1.Rows("A")

'count = Application.WorksheetFunction.CountA(rowRange)

count = WorksheetFunction.CountA(Sheets("QR Code").Range("A:A"))





Dim z As Long

 

   For z = 1 To count

    If ActiveSheet.Cells(z, 1) > "" Then

    x = ActiveSheet.Cells(z, 1)

    x = Replace(x, Space(1), "")

    QRCode_Create ActiveSheet.Cells(z, 4), x

    QRCode_Edit ActiveSheet.Cells(z, 4)

    End If

    Next z

  

'Druckbereich wählen

Print_area



End Sub





Sub QRCode_Create(ZielRange As Range, Text As String)

Dim wdapp As Object

Dim WD As Object

'Abgeleitet aus https://www.ms-office-forum.net/forum/showthread.php?p=2055193



On Error Resume Next

 

Set wdapp = GetObject(, "Word.Application")

If wdapp Is Nothing Then Set wdapp = CreateObject("Word.Application")

'wdapp.Application.Visible = 1

Set WD = wdapp.Documents.Add

WD.Fields.Add(Range:=WD.Range, Type:=-1, Text:="DISPLAYBARCODE " & Chr(34) & CStr(Text) & Chr(34) & " QR \q 3 \s 100 ", PreserveFormatting:=False).Copy

ZielRange.Select

ZielRange.Parent.PasteSpecial Format:="Picture (JPEG)", Link:=False, DisplayAsIcon:=False



Set wdapp = Nothing

Set WD = Nothing



wdapp.Quit 0





End Sub



Sub QRCode_Edit(ZielRange As Range)

    Selection.ShapeRange.LockAspectRatio = msoFalse

    Selection.ShapeRange.ScaleWidth 0.1651126718, msoFalse, msoScaleFromTopLeft

    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 454

    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 97

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 189

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 0

    Selection.ShapeRange.LockAspectRatio = msoFalse

    Selection.ShapeRange.IncrementTop 7.0587401575

    Selection.ShapeRange.ScaleHeight 0.9276018575, msoFalse, msoScaleFromTopLeft

    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 454

    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 97

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 189

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -3

    Selection.ShapeRange.LockAspectRatio = msoFalse

    Selection.ShapeRange.IncrementLeft 8.8234645669

    Selection.ShapeRange.ScaleWidth 0.8823538058, msoFalse, msoScaleFromTopLeft

    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 454

    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 97

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 185

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -3

    Selection.ShapeRange.LockAspectRatio = msoFalse

    Selection.ShapeRange.IncrementTop 0.00007874015748

    Selection.ShapeRange.ScaleHeight 0.7317079966, msoFalse, msoScaleFromTopLeft

    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 454

    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 97

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 185

    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 8

    'Größe ändern

    Selection.ShapeRange.LockAspectRatio = msoTrue

    Selection.ShapeRange.ScaleHeight 1.9, msoFalse, msoScaleFromTopLeft

    'Zentrieren

    For Each objShape In Tabelle1.Shapes

        With objShape

            If .Type = msoPicture Then

                .Left = .TopLeftCell.Left + .TopLeftCell.Width / 2 - .Width / 2

                .Top = .TopLeftCell.Top + .TopLeftCell.Height / 2 - .Height / 2

            End If

        End With

    Next

End Sub



Sub ZellenInhaltLoeschenx()

    Dim ws As Worksheet

    Dim d As Long

    Set ws = ThisWorkbook.Worksheets("QR Code") ' Ersetze "DeinArbeitsblattName" durch den tatsächlichen Namen deines Arbeitsblatts

'Löschen aller Bilder in Spalte D

For Each shp In ws.Shapes

If Not Intersect(shp.TopLeftCell, Range("D1:D100")) Is Nothing Then shp.Delete

Next shp



'Löschen des gesamten Text

Worksheets("QR Code").Range("A1:D100").ClearContents



       

End Sub



Sub Print_area()

    'Get values

    Dim wks As Worksheet

    Dim lastCell As Long

    

    For Each wks In ActiveWorkbook.Worksheets

        lastCell = wks.Range("A" & Rows.count).End(xlUp).Row

        wks.PageSetup.PrintArea = "A1:D" & lastCell

        With wks.PageSetup

            '.LeftHeader = "Test"

            '.CenterHeader = "Test"

            .CenterHorizontally = True

            .Orientation = xlPortrait

            '.PaperSize = xlPaperA2

            .FitToPagesWide = 1

        End With

    Next wks

End Sub

Grüße Marco

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Infobox zum Thema

EXCEL - QR Code erstellen

Die Fragestellung

Du möchtest wissen, wie man in Excel einen QR-Code erstellen kann.

Erläuterung des Problems {#erläuterung-des-problems}

QR-Codes sind zweidimensionale Barcodes, die Informationen speichern und leicht mit einem Smartphone gescannt werden können. Sie werden häufig verwendet, um URLs, Kontaktinformationen oder andere Daten schnell zu teilen.

Lösung des Problems {#lösung-des-problems}

Excel bietet keine native Unterstützung zur Erstellung von QR-Codes, aber es gibt mehrere Möglichkeiten, dies zu erreichen:

Add-In verwenden:
- Installiere ein Excel-Add-In, das die Erstellung von QR-Codes unterstützt. Es gibt verschiedene Add-Ins verfügbar, die du über den Microsoft Store in Excel finden kannst.
Online-Generator nutzen und das Bild einfügen:
- Verwende einen Online-QR-Code-Generator, um den QR-Code zu erstellen. Speichere den QR-Code als Bild und füge ihn dann in dein Excel-Dokument ein.
- Beispiel für Online-Generatoren: goqr.me, qr-code-generator.com.
VBA-Makro:
- Schreibe oder verwende ein bestehendes VBA-Makro, das eine API wie Google Chart API aufruft, um einen QR-Code zu generieren und in Excel einzufügen.

Hier ist ein einfaches Beispiel für ein VBA-Makro, das die Google Chart API verwendet, um einen QR-Code zu erstellen:

Sub GenerateQRCode()
    Dim url As String
    Dim QRCodeURL As String
    Dim cellValue As String

    ' Der Wert, der in den QR-Code umgewandelt werden soll
    cellValue = "Hier deinen Text oder URL einfügen"

    ' URL für Google Chart API mit dem Zellwert
    QRCodeURL = "https://chart.googleapis.com/chart?chs=150x150&cht=qr&chl=" & cellValue

    ' Füge das Bild in das Arbeitsblatt ein
    With ActiveSheet.Pictures.Insert(QRCodeURL)
        .ShapeRange.LockAspectRatio = msoFalse
        .Width = 150
        .Height = 150
        .Top = Range("A1").Top  ' Positioniere das Bild bei A1
        .Left = Range("A1").Left
    End With
End Sub

Ersetze "Hier deinen Text oder URL einfügen" mit dem Text oder der URL, die du in einen QR-Code umwandeln möchtest.

Anwendungsbeispiele aus der Praxis

Geschäftskarten: Erstelle QR-Codes für Kontaktinformationen.
Inventarmanagement: Erstelle QR-Codes, die auf Produktinformationen oder -seiten verlinken.
Eventmanagement: Erstelle QR-Codes für Event-Tickets oder Informationen.

Tipps

Stelle sicher, dass der Text oder die URL, die du in einen QR-Code umwandelst, korrekt und vollständig ist.
Teste den QR-Code mit einem Smartphone, um sicherzustellen, dass er wie erwartet funktioniert.

Zusammenfassung

Die Erstellung von QR-Codes in Excel erfordert entweder die Verwendung eines Add-Ins, eines Online-Generators oder die Implementierung eines VBA-Makros, das eine externe API aufruft. Jede Methode hat ihre eigenen Vor- und Nachteile, und die Wahl hängt von den spezifischen Anforderungen und der verfügbaren Infrastruktur ab.

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

51 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Infobox zum Thema

EXCEL - QR Code erstellen

Inhaltsverzeichnis

Die Fragestellung

Erläuterung des Problems {#erläuterung-des-problems}

Lösung des Problems {#lösung-des-problems}

Anwendungsbeispiele aus der Praxis

Tipps

Verwandte Themenbereiche

Zusammenfassung

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

QR Code erstellen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

51 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Infobox zum Thema

EXCEL - QR Code erstellen

Inhaltsverzeichnis

Die Fragestellung

Erläuterung des Problems {#erläuterung-des-problems}

Lösung des Problems {#lösung-des-problems}

Anwendungsbeispiele aus der Praxis

Tipps

Verwandte Themenbereiche

Zusammenfassung

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread