Per Word erstellten QR-Code verkleinern

Forumthread: Per Word erstellten QR-Code verkleinern

08.04.2026 15:06:23

Charate

Hallo,

Ich habe auf Basis dieses Threads (https://www.herber.de/forum/archiv/1892to1896/1892223_EPC_GiroCode_per_VBA.html#threadbox) ein Makro geschrieben, welches einen Gircode-QR-Code per Word erstellt und ihn auch in Excel übernimmt.

- Kurzer Hinweis: Ich hätte meine Frage gerne an den Thread angehängt, habe aber nachdem ich 15 Minuten lang keinen Login Button auf der Seite gefunden habe und auch keine Möglichkeit eine Antwort zu schreiben (ggf. ist der Thread gesperrt, da zu alt?), habe ich mich dann dafür entschieden einen neuen Thread zu öffnen, da ich hier ja scheinbar automatisch eingeloggt werde. Seht es mir daher bitte nach, ich möchte das Forum nicht unnötig mit neuen Threads zuspammen. -

Nun zu meiner Frage:
Da der erstellte QR-Code relativ groß ist, habe ich mich gefragt, ob man ihn irgendwie verkleinern kann. Ich denke es gibt eine Funktion um die Grafik zu skalieren, was aber wahrscheinlich dazu führen dürfte, dass der Code unlesbar wird. Daher die Frage, ob es in dem Code eine Möglichkeit gibt, die große des QR-Code anzugeben?

Hier der (aus meiner Sicht) relevante Code-Bereich:



Sub QRCode_Create(ZielRange As Range, Text As String)

Dim WA As Object

Dim WD As Object

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

Set WA = CreateObject("Word.Application")

Set WD = WA.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

WD.Close False

End Sub

Vielen Dank für die Unterstützung!

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Bildgröße ändern

08.04.2026 16:10:07

MCO
Vielen Dank!

09.04.2026 12:02:13

Charate
Dafür gibt's einen Parameter

08.04.2026 21:58:36

xlKing
Danke!

09.04.2026 12:00:11

Charate
Sowas mache ich...

09.04.2026 00:03:54

Case
Banking-App stürzt ab :(

09.04.2026 16:38:33

Charate
Na - das ist ja...

09.04.2026 18:32:33

Case
Wir können ihn mit dem....

09.04.2026 19:50:18

Case

Bildgröße ändern

08.04.2026 16:10:07

MCO

Mahlzeit!

Sub mit Parametern kannst du das mal versuchen:

Sub Pic_resize(pic As Object, Seitenverh_sperr As Boolean, Optional höhe As Long, Optional Breite As Long, Optional Pos_li As Long)

    

    'Pic_resize pic, 1, zelle.Height, , zelle.Top, Range("L" & zelle.Row).Left + 30 'Größe und Position festlegen durch Subroutine

    With pic

        If höhe > 0 Then .Height = höhe

        If Breite > 0 Then .Width = Breite

        If Pos_vert > 0 Then .Top = Pos_vert

        If Pos_hori > 0 Then .Left = Pos_hori

        .Placement = 1

        'xlFreeFloating  3   ist frei verschiebbar.

        'xlMove          2   wird mit den Zellen verschoben.

        'xlMoveAndSize   1   wird mit den Zellen verschoben und vergrößert/verkleinert.

    End With

End Sub

Außerdem hatte ich das mal gebastelt, muss aber wohl mal angepasst werden:

Aufruf mit

QRCode_Edit ActiveSheet.Range("r9")

Sub QRCode_Edit(ZielRange As Range)



    For Each shp In ActiveSheet.Shapes

        If shp.TopLeftCell.Address(0, 0) = ZielRange.Address(0, 0) Then Exit For

    Next shp



    With shp

    

        'Am besten die gewünschten Änderungen aufzeichnen

    

'        .LockAspectRatio = msoFalse

'        .ScaleWidth 0.1651126718, msoFalse, msoScaleFromTopLeft

'        .PictureFormat.Crop.PictureWidth = 454

'        .PictureFormat.Crop.PictureHeight = 97

'        .PictureFormat.Crop.PictureOffsetX = 189

'        .PictureFormat.Crop.PictureOffsetY = 0

'        .LockAspectRatio = msoFalse

'        .IncrementTop 7.0587401575

'

''

'        .ScaleHeight 0.7317079966, msoFalse, msoScaleFromTopLeft

'        .PictureFormat.Crop.PictureWidth = 454

'        .PictureFormat.Crop.PictureHeight = 97

'        .PictureFormat.Crop.PictureOffsetX = 185

'        .PictureFormat.Crop.PictureOffsetY = 8

''        'Größe ändern

'        .LockAspectRatio = msoTrue

'        '.ScaleHeight 1.9, msoFalse, msoScaleFromTopLeft

    End With

'Zentrieren



End Sub

Viel Erfolg!
Gruß, MCO

Vielen Dank!

09.04.2026 12:02:13

Charate

Danke dir! Die Lösung von xlKing hat ganz nativ funktioniert, daher bin ich damit gegangen. Danke dir trotzdem für deine Unterstützung!

Dafür gibt's einen Parameter

08.04.2026 21:58:36

xlKing

Hi,

mach doch einfach, anstelle von " QR \q 3 \s 100 " lieber " QR \q 3 \s 50 ". Der Wert hinter \s wird in Prozent angegeben. Du kannst beliebige Ganzzahlen zwischen 10 und 1000 angeben.

Nähere Infos zu den Parametern: https://support.microsoft.com/de-de/office/feldfunktionen-displaybarcode-6d81eade-762d-4b44-ae81-f9d3d9e07be3

Gruß Mr. K.

Danke!

09.04.2026 12:00:11

Charate

Super! Das funktioniert :)! Hätte ich irgendwie selber drauf kommen können *:D
Jetzt werde ich noch den Zint-Barcode-Generator von Case versuchen einzubinden!
Danke für die Hilfe :)!

Sowas mache ich...

09.04.2026 00:03:54

Case

Moin, :-)

... gerne ohne Word. Dafür nutze ich den"Zint Barcode Generator": ;-)
https://sourceforge.net/projects/zint/

Mit diesem Code: ;-)

Option Explicit

Public Sub Main()

    Dim strQRString As String

    Dim strFile As String

    Dim objPic As Object

    strQRString = "BCD\n" & _

        "002\n" & _

        "2\n" & _

        "SCT\n\n" & _

        Range("Name").Value & "\n" & _

        Replace(Range("IBAN").Value, " ", "") & "\n" & _

        "EUR" & Replace(Format(Range("Betrag").Value, "0.00"), ",", ".") & "\n" & Range("Zweck").Value

    strFile = ThisWorkbook.Path & Application.PathSeparator & "QR_Code.png"

    If Dir(strFile) > "" Then Kill strFile

    With CreateObject("WScript.Shell")

        .Run "cmd /c """ & "C:\Temp\zint\zint.exe -b 58 -o """ & strFile & """ -d """ & strQRString & """" & """", 0, True

    End With

    Tabelle1.Pictures.Delete

    Set objPic = Tabelle1.Pictures.Insert(strFile)

    With objPic

        .Top = .Parent.Range("F5").Top

        .Left = .Parent.Range("F5").Left

        .Width = .Parent.Range("F5").Width

        .Height = .Parent.Range("F5").Height

        .Placement = xlMoveAndSize

    End With

End Sub

Bekommst du das: ;-)

Userbild

Der "String" unter dem "Bild" ist der dekodierte QR-Code. Habe ich nur zum testen drin. ;-)
Sollte EPC konform sein. ;-)
Den Zint-Pfad im Code musst du an deine Gegebenheiten anpassen. ;-)

Servus
Case

Banking-App stürzt ab :(

09.04.2026 16:38:33

Charate

Hallo Case,

Danke dir für den Code! Grundsätzlich gefällt mir der Gedanke einer MS-freie-Version sehr gut :D! Habe den Code ausprobiert, hat aber erstmal nicht funktioniert, weshalb ich dann die Befehle für den "strQRString" aus dem alten Sub kopiert habe, dann gings (ist natürlich etwas weniger elegant, aber nu).
Das JPG fügt er leider nicht in die Tabelle ein, es wir aber generiert. Wenn ich es versuche mit meiner Banking-App zu scannen, stürzt die aber ab :(... Hast du eine Idee, woran das liegen könnte?

Na - das ist ja...

09.04.2026 18:32:33

Case

Moin, :-)

... nicht "Sinn und Ziel". ;-)

Zint ist extrem mächtig - aber auch sehr "genau". Um das Problem des /n bzw. Zeilenumbruchs zu umgehen, können wir Zint anders "füttern". ;-)

Dann gibt es noch mehr Stolperfallen. Mit SEPA ist die Angabe der BIC eigentlich Optional. Manche wollen es aber. Um maximal kompatibel zu bleiben können wir die Version "1" nehmen und den Charset "1" (Latin 1), statt "2" (UTF 8). ;-)

Jetzt gibt es erstmal ein "kleines" Abendessen, dann erstelle ich dir etwas. ;-)

Servus
Case

Wir können ihn mit dem....

09.04.2026 19:50:18

Case

Moin, :-)

... Parameter /i anders "füttern": ;-)
https://www.herber.de/bbs/user/180504.xlsb

Der "Text" unter dem QR-Code ist die Ausgabe der Dekodierung - nur zur Info. ;-)

Informationen zu den Versionen, Charset und mehr: ;-)
https://de.wikipedia.org/wiki/EPC-QR-Code

Den String musst du eventuell auf deine Gegebenheiten anpassen. ;-)

Servus
Case

Per Word erstellten QR-Code verkleinern

Forumthread: Per Word erstellten QR-Code verkleinern

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread