Bild per VBA "bearbeiten"

[andre]

Hi,

ist es möglich ein Bild welches ich per VBA generieren zu bearbeiten?

Ich habe einen simplen Code welcher mir einrn QR-Code generiert und als Bilddatei ausgibt. Diesen QR-Code möchte ich statt dem klassischen Schwarz auf Weiß z.B. Grau auf Weiß darstellen (z.B. Helligkeit höher oder Kontrast). Ist dies per VBA möglich? Wenn ja wie?

Danke vorab!

[HKindler]

Hi,

eigentlich wollt ich ja antworten: "Alles was du per Hand in Excel sebst erledigen kannst, kannst du auch mit VBA machen. Also nimm den Makrorekorder und zeichne damit deine händischen Schritte auf. Schon hast du ein Gerüst für dein Makro." Allerdings zeichnet der Rekorder Bildbearbeitungsbefehle wie erhöhen der Helligkeit nicht auf. Was jetzt nicht heißt, dass VBA das nicht kann.

Eine kleine Rechere in den Objekteigenschaften hat gezeigt, dass z.B. ActiveSheet.Shapes(1).PictureFormat.Brightness die Helligkeit eines Bildes ändert. 0.5 wäre normal, 0 ist komplett Schwarz und 1 ist komplett weiß.

Aber wieso nachträglich etwas ändern? ich würde bereits beim generieren des QR-Codes ansetzen. Wie sieht denn jenes Makro aus?

Irgendwie stellt sich mir die Frage nach dem Hintergrund deiner Frage. Durch ein Verringern des Kontrastes (nichts anderes ist das Verwenden von Grau/Weiß statt Schwarz/Weiß) verringerst du auch die Lesbarkeit des Codes. Und das will man ja im Allgemeinen eher nicht haben.

[andre]

i,

genau so hätte ich es gerne ja. Allerdings funktioniert das irgendwie einfach nicht.

Der Hintergrund ist recht simple. Das Design ist alles "Dunkelgrau", das Schwarz Sticht heraus, also nur leicht heller reicht.

Anbei einmal der gesamte Code:

Function QRCode2(QRCode2_Wert As String) As String

'Variablen deklarieren
Dim rngCell As Range
Dim sURL2 As String

'Zelle auslesen
Set rngCell = Application.Caller

'URL definieren
sURL2 = "https://chart.googleapis.com/chart?cht=qr&&chs=120x100&&chl=" & QRCode2_Wert

'QR-Code alt löschen, falls vorhanden
On Error Resume Next
ActiveSheet.Pictures("QRCode2_" & rngCell.Address).Delete

'QR-Code einfügen
With ActiveSheet.Pictures.Insert(sURL2)
    .Name = "QRCode2_" & rngCell.Address
    .Left = rngCell.Left + 1
    .Top = rngCell.Top + 1
    .SendToBack
    .ActiveSheet.Shapes(1).PictureFormat.Brightness 0.5

End With

End Function

Der QR-Code/das Bild wird nach wie vor "normal" angezeigt.

[HKindler]

Hi,

Kann‘s grad nicht testen, da ich am iPad sitze. Habe jetzt auch keine Lust, dir wegen

Code:

ActiveSheet.Pictures.Insert(sURL2) .ActiveSheet.Shapes(1).PictureFormat.Brightness 0.5

(was dein Code ja effektiv darstellt) gleich doppelt auf die Finger zu hauen, sondern verrate dir gleich, dass du statt des von dir rot markierten Teils vielleicht besser

Code:

.PictureFormat.Brightness = 0.7

verwenden solltest…

Übrigens ein klein wenig mitdenken ist nicht verboten!

[andre]

Hi,

ich muss dazusagen, dass ist mein allererstes VBA-Projekt...

Danke für deine Hilfe, aber damit hat es auch nicht funktioniert. Also so sieht nun der Code aus:

Code:

Option Explicit

Function QRCode2(QRCode2_Wert As String) As String

'Variablen deklarieren
Dim rngCell As Range
Dim sURL2 As String

'Zelle auslesen
Set rngCell = Application.Caller

'URL definieren
sURL2 = "https://chart.googleapis.com/chart?cht=qr&&chs=120x100&&chl=" & QRCode2_Wert

'QR-Code alt löschen, falls vorhanden
On Error Resume Next
ActiveSheet.Pictures("QRCode2_" & rngCell.Address).Delete

'QR-Code einfügen
With ActiveSheet.Pictures.Insert(sURL2)
    .Name = "QRCode2_" & rngCell.Address
    .Left = rngCell.Left + 1
    .Top = rngCell.Top + 1
    .SendToBack
    .PictureFormat.Brightness = 0.5

End With

End Function

[HKindler]

Hi,

Was heißt „funktioniert nicht“?
Wenn sich nichts ändert, brauchst du dich nicht wundern, denn 0.5 ist die Normalstellung. 0.4 wäre etwas dunkler, 0.6 etwas heller.

Außerdem solltest du „on error resume next“ auskommentieren oder nach dem xxx.Delete mit „on error goto 0“ wieder einschalten.

[andre]

Ich sehe von 0.1 bis 0.9 keinen Unterschied

[HKindler]

Hast du gesehen, dass ich noch etwas ergänzt habe?
Ansonsten geht es von meiner Seite erst morgen weiter. Erst dann kann ich selbst testen…

[andre]

Ja - ich denke.

So sieht es aus:

Code:

Option Explicit

Function QRCode2(QRCode2_Wert As String) As String

'Variablen deklarieren
Dim rngCell As Range
Dim sURL2 As String

'Zelle auslesen
Set rngCell = Application.Caller

'URL definieren
sURL2 = "https://chart.googleapis.com/chart?cht=qr&&chs=120x100&&chl=" & QRCode2_Wert

'QR-Code alt löschen, falls vorhanden
On Error Resume Next
ActiveSheet.Pictures("QRCode2_" & rngCell.Address).Delete


'QR-Code einfügen
With ActiveSheet.Pictures.Insert(sURL2)
    .ActiveSheet.Shapes(1).PictureFormat.Brightness 0.1
    .PictureFormat.Brightness = 0.1
    .Name = "QRCode2_" & rngCell.Address
    .Left = rngCell.Left + 1
    .Top = rngCell.Top + 1
    .SendToBack

End With

End Function

[Kuwer]

Hallo,

Du kannst es ja mal mit

Code:

.PictureFormat.ColorType = msoPictureWatermark

testen.

Wie verwendest Du diese Function QRCode2 konkret?

Gruß, Uwe