Hi,
habe deinen Code mal ein wenig angepasst.
Was habe ich alles geändert? Und damit ein QRCode der Größe 120x100 mit dem Text "DeinText" erzeugt.
Frag mich jetzt nicht, wieso die doppelten & vorhanden sind. Es reichen auch einfache.
Neu wird jetzt verwendet:Also wieder ein QRCode mit Größe 120x100, schwarzem Text auf weißem Grund und nicht transparentem weißem Rahmen mit dem Text "DeinText". Also im Moment genau das selbe wie bisher. Nur kannst du mit z.B. chco=FF0000,00FF00 einen QRCode mit Rot auf Grün erzeugen. Und die Fläche um den Code (den Rahmen) mit chf=bg,s,0000FF66 auf halb transparentes (50%) Blau setzen. Es sind natürlich beliebige Farben machbar.
Innerhalb des With-Blocks sind die beiden VBA-Befehle zur Änderung von Helligkeit und Kontrast untergebracht. Allerdings sin sie auskommentiert, weil ich es für weniger zielführend erachte als wenn man direkt die Bildfarben setzt. Statt .Brightness und .Contrast könnte man auch .IncrementBrightness und .IncrementContrast verwenden.
Wenn es dir nicht gefällt, dass die Funktion nun einen Zeitstempel statt eines Leerstring zurück gibt, dann kommentierst du einfach die letzte Zeile aus. Der Zeitstempel verschwindet allerdings normalerweise hinter dem QRCode und ist somit nicht sichtbar.
habe deinen Code mal ein wenig angepasst.
Code:
Function QRCode2(QRCode2_Wert As String) As Variant
'Variablen deklarieren
Dim rngCell As Range
Dim sURL2 As String
'Zelle auslesen
Set rngCell = Application.Caller
'URL definieren
'in folgender URL gelten die Parameter (siehe developers.google.com/chart/image/docs/chart_params?hl=de)
'cht=qr QR-Code erzeugen
'chs=120x100 Bildgröße
'chco=RRGGBB,RRGGBB Farbe1(Schwarz),Farbe2(Weiß) als hexadezimaler RGB-Wert
'chf=bg,s,RRGGBBTT Rahmenfarbe(Weiß) als hexadezimaler RGBT-Wert T=Transparenz (FF=undurchsichtig) (bg=Hintergrund, s=solid)
'chl=text Inhalt
sURL2 = "https://chart.googleapis.com/chart?cht=qr&chs=120x100&chco=000000,FFFFFF&chf=bg,s,FFFFFFFF&chl=" & QRCode2_Wert
'sURL2 = "https://chart.googleapis.com/chart?cht=qr&&chs=120x100&&chl=" & QRCode2_Wert
'QR-Code alt löschen, falls vorhanden
On Error Resume Next
rngCell.Worksheet.Pictures("QRCode2_" & rngCell.Address).Delete
On Error GoTo 0
'QR-Code einfügen
With rngCell.Worksheet.Pictures.Insert(sURL2)
'.ShapeRange.PictureFormat.Brightness = 0.5 'Helligkeit setzen, normal: 0.5
'.ShapeRange.PictureFormat.Contrast = 0.5 'Kontrast setzen, normal: 0.5
.Name = "QRCode2_" & rngCell.Address
.Left = rngCell.Left + 1
.Top = rngCell.Top + 1
.SendToBack
End With
'aktueller Zeitstempel als Rückgabe-Wert
QRCode2 = Now
End Function
Was habe ich alles geändert?
- die Funktion gibt nun Datum/Uhrzeit in der Zelle zurück (finde ich ganz nützlich)
- statt ActiveSheet wird rngCell.Worksheet und damit im Endeffekt Application.Caller.Worksheet verwendet
- die Fehler werden nur noch da ignoriert, wie dies notwendig ist (On Error Resume Next zum Unterdrucken der Fehler und On Error Goto 0 um wieder darauf zu reagieren)
- innerhalb der URL werden die einzelnen Farben explizit gesetzt
- das Bild könnte über Helligkeit und Kontrast angepasst werden (ist aber hier auskommentiert)
Code:
cht=qr&&chs=120x100&&chl=DeinText
Frag mich jetzt nicht, wieso die doppelten & vorhanden sind. Es reichen auch einfache.
Neu wird jetzt verwendet:
Code:
cht=qr&chs=120x100&chco=000000,FFFFFF&chf=bg,s,FFFFFFFF&chl=DeinText
Innerhalb des With-Blocks sind die beiden VBA-Befehle zur Änderung von Helligkeit und Kontrast untergebracht. Allerdings sin sie auskommentiert, weil ich es für weniger zielführend erachte als wenn man direkt die Bildfarben setzt. Statt .Brightness und .Contrast könnte man auch .IncrementBrightness und .IncrementContrast verwenden.
Wenn es dir nicht gefällt, dass die Funktion nun einen Zeitstempel statt eines Leerstring zurück gibt, dann kommentierst du einfach die letzte Zeile aus. Der Zeitstempel verschwindet allerdings normalerweise hinter dem QRCode und ist somit nicht sichtbar.
Gruß,
Helmut
Win10 - Office365 / MacOS - Office365
Helmut
Win10 - Office365 / MacOS - Office365