QR-Code mittels Public Function einfügen

Hallo liebe Excel-Profis,
zur Erläuterung meines Problems kurz folgender Hintergrund:
Ich möchte gerne meinen Rechnungen einen Grafik-QR-Bezahlcode hinzufügen.
Dazu habe ich mir folgende Tabelle als Vorlage eingerichtet:
https://www.herber.de/bbs/user/148917.xlsm
Für die, die nicht gern Dateien mit Makros runterladen, hier auch noch mal eine kurze Erläuterung:
Die Angaben zu Empfänger, IBAN, BIC, Betrag und Verwendungszweck sind in der Beispielstabelle in den Zellen D2 bis D6 eingetragen. In einer weiteren Zelle (im vorliegenden Beispiel in B2) habe ich eine benutzerdefinierte Funktion eingefügt, die der Funktion die Werte der besagten Zellen in D2 bis D6 als Argumente übergibt. Die Ausgestaltung als Funktion ist mir wichtig, da ich möchte, dass das Ganze bei jeder Änderung dieser Angaben neu berechnet und eine neue QR-Grafik erzeugt wird.
Den Code des Moduls füge ich untern nochmal an.
Ich habe jetzt folgendes Problem:
Alles klappt wurderbar, nur die letzte Zeile mit dem PasteSpecial-Befehl bewirkt einfach nichts, keine Fehlermeldung, aber auch nicht das Einfügen der Grafik.
Was nun kurios ist: Wenn ich die besagte Befehlszeile nach Durchlauf der Funktion händisch über das Sub starte, wird die Grafik eingefügt. Aber nur bei händischem Starten, ein automatisierter Aufruf am Ende der Funktion bewirk wieder nichts!
Hier noch einmal der Code des entsprechenden Moduls:
Option Explicit
Const BarcodeWidth As Integer = 92 'Breite des QR-Codefensters


Public Function pf_QRCode(Empfänger As String, IBAN As String, BIC As String, Betrag As String, Verwendungszweck As String) As String
Dim BarcodeText As String, wdapp As Word.Application
BarcodeText = ufunc_Sonderzeichen("bank://singlepaymentsepa?name=" & Empfänger & "&reason=" & Verwendungszweck & "&iban=" & IBAN & "&bic=" & BIC & "&amount=" & Betrag)
BarcodeText = "DISPLAYBARCODE '" & BarcodeText & "' QR \s 50 \q 3"
pf_QRCode = BarcodeText
'   Den Klartext in QR-Grafik umwandeln
Set wdapp = CreateObject("Word.Application")
With wdapp.Documents.Add
.Fields.Add(Range:=.Range, Type:=-1, Text:=BarcodeText, PreserveFormatting:=False).Copy
.Close savechanges:=False
End With
wdapp.Quit: Set wdapp = Nothing
ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False
End Function


Private Function ufunc_Sonderzeichen(UmzuwandelnderText As String) As String
UmzuwandelnderText = Replace(UmzuwandelnderText, " ", "%20")
UmzuwandelnderText = Replace(UmzuwandelnderText, ",", "%2C")
ufunc_Sonderzeichen = UmzuwandelnderText
End Function


Private Sub usub_QR_Grafik()
ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False
End Sub

Viele Grüße aus der Lüneburger Heide!
Norbert

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo onur,
vielen Dank für die schnelle Antwort, die mir eine echte Hilfe bei weiteren Überlegungen ist.. Zumindest kann die Funktion ja außerhalb von Excel etwas bewirken, denn sie erzeugt ja ein Word-Dokument, fügt diesem ein Feld mit der Grafik zu und kopiert das in die Zwischenablage. In die Richtung werde ich weiter überlegen. Vielleicht erstelle ich neben der Excel Tabelle noch ein eigenständiges Dokument, das ich dann mit der Funktion nur noch öffne und manipuliere (Feld hinzufügen mit Grafik) und dem ich dann einen Code verpasse, der dann aus der Word-Welt wieder in die Excel-Welt hineinwirkt. Das wäre ein bisschen von hinten durchs Knie ins Auge,aber schauen wir mal.
Viele Grüße
Norbert

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 2 Then Call insertPic(Target.Value, Target) End Sub 'dieses Makro in ein allgemeines Modul 'ist jetzt nicht das Schönste aber bei mir funktioniert es. Sub insertPic(sText As String, r As Range) Dim wdapp As Word.Application Dim shp As Shape Set wdapp = CreateObject("Word.Application") With wdapp.Documents.Add .Fields.Add Range:=.Range, Type:=-1, Text:=sText, PreserveFormatting:=False .Fields.ToggleShowCodes .Fields(1).Select .Fields(1).Copy r.Offset(2).Select ThisWorkbook.ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False Set shp = ActiveSheet.Shapes(ActiveSheet.Shapes.Count) With shp .TopLeftCell = r.Top + r.Height End With r.Select .Close savechanges:=False End With wdapp.Quit: Set wdapp = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

QR-Code mittels Public Function einfügen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread