Herbers Excel/VBA-Archiv
| Informationen und Beispiele zum Thema MsgBox | |
|---|---|
 Screenshot zu MsgBox |
MsgBox-Seite mit Beispielarbeitsmappe aufrufen |
Bild per Link in eine Zelle anzeigen
- Bild per Link in eine Zelle anzeigen von Olaf vom 06.09.2020 23:45:21
- AW: Bild per Link in eine Zelle anzeigen - von volti am 07.09.2020 09:09:09
- AW: Bild per Link in eine Zelle anzeigen - von volti am 07.09.2020 12:03:23
- AW: Bild per Link in eine Zelle anzeigen - von Olaf am 07.09.2020 18:55:14
- AW: Bild per Link in eine Zelle anzeigen - von Olaf am 07.09.2020 19:32:59
- AW: Bild per Link in eine Zelle anzeigen - von volti am 07.09.2020 19:44:40
- AW: Bild per Link in eine Zelle anzeigen - von Olaf am 07.09.2020 22:43:46
- AW: Bild per Link in eine Zelle anzeigen - von volti am 07.09.2020 22:57:24
- AW: Bild per Link in eine Zelle anzeigen - von volti am 08.09.2020 11:59:28
- AW: Bild per Link in eine Zelle anzeigen - von Olaf am 08.09.2020 15:37:26
- AW: Bild per Link in eine Zelle anzeigen - von Olaf am 08.09.2020 15:37:26
- AW: Bild per Link in eine Zelle anzeigen - von volti am 07.09.2020 22:57:24
- AW: Bild per Link in eine Zelle anzeigen - von Olaf am 07.09.2020 22:43:46
- AW: Bild per Link in eine Zelle anzeigen - von Olaf am 07.09.2020 19:32:59
- AW: Bild per Link in eine Zelle anzeigen - von Olaf am 07.09.2020 18:55:14
- AW: Bild per Link in eine Zelle anzeigen - von volti am 07.09.2020 12:03:23
Geschrieben am: 06.09.2020 23:45:21
Hallo zusammen,
ich hoffe Ihr könnt mir helfen,
mit der Datei kann man einen QR Code erzeugen. dieses geschieht mit Google, das QR code Bild wird im Verzeichnis abgelegt wo sich die Excel Datei befindet.
in der Spalte "C" steht der Name der Datei und in der Spalte "D" soll das Bild in die Zelle eingefügt werden
es wäre toll, wenn das mit VBA automatisch in einer Rutsche gehen würde.
https://www.herber.de/bbs/user/140077.xlsm
Gruß
Olaf
von: volti
Geschrieben am: 07.09.2020 09:09:09
Hallo Olaf,
hier mal eine erste Idee zu Deinem Vorhaben. Ich habe Deinen Code weitgehend beibehalten.....
Neu ist, dass nur Felder aus Spalte "C" berücksichtigt werden und das Pic an das Feld "D" angepasst wird. Ggf. wird es verzerrt, dann bitte einfach die Spaltenbreite reduzieren.
Tipp: Du solltest keine reservierten Namen für Variablen nehmen und eher sprechende Name verwenden.
Deshalb habe ich sName und Zelle statt Name und val eingeführt.
Schau mal, ob es so schon passt:
QR-Code.xlsm
viele Grüße
Karl-Heinz
von: volti
Geschrieben am: 07.09.2020 12:03:23
Hallo Olaf,
ich habe mir das spannende Thema mal für mich aufbereitet.
Wenn Du möchtest, kannst Du es gerne übernehmen und in Dein Tool einbauen.
Es ist jetzt nur noch eine Sub und die temporäre Zwischendatei wird gleich nach dem Einfügen wieder gelöscht.
Code:
Option Explicit
Sub InsertQR()
'Sub erstellt einen QR-Code und fügt ihn in das Blatt ein
Dim rZelle As Range, AC As Range, xHttp As Object
Dim iSize As Integer, i As Integer
Dim sPicFilename As String, sQR As String
If Not TypeName(Selection) Like "Range" Then Exit Sub 'Keine korrekte Markierung
Set xHttp = CreateObject("Microsoft.XMLHTTP")
iSize = 250 'dalam Pixels
For Each rZelle In Selection 'Alle Zellen in Selektion durchgehen
With rZelle
If .Column = 3 And .Value <> "" Then 'Nur Spalte C und vorhandenem Wert
'Datei auf Fehler untersuchen
For i = 1 To Len(.Value)
If InStr(Chr(34) & "\/:*?<>"=,;", Mid(.Value, i, 1)) > 0 Then
MsgBox "Die Datei " & vbCrLf & "'" & .Value & "'" _
& vbCrLf & vbCrLf & " enthält fehlerhafte Zeichen!"
Exit Sub
End If
Next
'Url zusammenbauen
sQR = "http://chart.googleapis.com/chart?chs=" _
& iSize & "x" & iSize & "&cht=qr&chl=" & .Value
xHttp.Open "GET", sQR, False
xHttp.Send
'Picnamen/Pfad zusammenbauen
sPicFilename = Environ("TEMP") & "\" & .Value 'Datei ins Temp-Verzeichnis
If Not sPicFilename Like "*.png" Then sPicFilename = sPicFilename & ".png"
With CreateObject("Adodb.Stream")
.Type = 1 '//binary
.Open
.write xHttp.responseBody
.savetofile sPicFilename, 2 'überschreiben
.Close
End With
'Bild wird an Zelle in Spalte D angepasst
Set AC = .Offset(0, 1)
ActiveSheet.Shapes.AddPicture(sPicFilename, False, True, _
AC.Left + 1, AC.Top + 1, _
AC.Width - 2, AC.Height - 2).Name = "QR_" & .Value
If Dir(sPicFilename) <> "" Then Kill sPicFilename 'Datei löschen
End If
End With
Next rZelle
Set xHttp = Nothing
End Sub
Sub InsertQR()
'Sub erstellt einen QR-Code und fügt ihn in das Blatt ein
Dim rZelle As Range, AC As Range, xHttp As Object
Dim iSize As Integer, i As Integer
Dim sPicFilename As String, sQR As String
If Not TypeName(Selection) Like "Range" Then Exit Sub 'Keine korrekte Markierung
Set xHttp = CreateObject("Microsoft.XMLHTTP")
iSize = 250 'dalam Pixels
For Each rZelle In Selection 'Alle Zellen in Selektion durchgehen
With rZelle
If .Column = 3 And .Value <> "" Then 'Nur Spalte C und vorhandenem Wert
'Datei auf Fehler untersuchen
For i = 1 To Len(.Value)
If InStr(Chr(34) & "\/:*?<>"=,;", Mid(.Value, i, 1)) > 0 Then
MsgBox "Die Datei " & vbCrLf & "'" & .Value & "'" _
& vbCrLf & vbCrLf & " enthält fehlerhafte Zeichen!"
Exit Sub
End If
Next
'Url zusammenbauen
sQR = "http://chart.googleapis.com/chart?chs=" _
& iSize & "x" & iSize & "&cht=qr&chl=" & .Value
xHttp.Open "GET", sQR, False
xHttp.Send
'Picnamen/Pfad zusammenbauen
sPicFilename = Environ("TEMP") & "\" & .Value 'Datei ins Temp-Verzeichnis
If Not sPicFilename Like "*.png" Then sPicFilename = sPicFilename & ".png"
With CreateObject("Adodb.Stream")
.Type = 1 '//binary
.Open
.write xHttp.responseBody
.savetofile sPicFilename, 2 'überschreiben
.Close
End With
'Bild wird an Zelle in Spalte D angepasst
Set AC = .Offset(0, 1)
ActiveSheet.Shapes.AddPicture(sPicFilename, False, True, _
AC.Left + 1, AC.Top + 1, _
AC.Width - 2, AC.Height - 2).Name = "QR_" & .Value
If Dir(sPicFilename) <> "" Then Kill sPicFilename 'Datei löschen
End If
End With
Next rZelle
Set xHttp = Nothing
End Sub
viele Grüße aus Freigericht
Karl-Heinz
Karl-Heinz
von: Olaf
Geschrieben am: 07.09.2020 18:55:14
Hallo Karl-Heinz, danke das Du Dich meiner Sache angenommen hast.
ich habe Deine Datei aufprobiert, es wird aber kein QR Code Bild mehr erzeugt.
dem entsprecht auch kein Bild angezeigt.
Gruß Olaf
von: Olaf
Geschrieben am: 07.09.2020 19:32:59
.
von: volti
Geschrieben am: 07.09.2020 19:44:40
Hallo Olaf,
bei mir werden erfolgreich die QR-Codes erzeugt und als Bild eingefügt.
Hast Du denn auch in Spalte "C" die Markierungen der gewünschten Felder durchgeführt?
Andere Markierungen werden ignoriert, damit das ganze ordentliche Vorgaben hat.
Ich habe jetzt noch eine Fehlermeldung eingebaut, falls nichts ins Spalte C markiert ist.
QR-Codes
viele Grüße
Karl-Heinz
von: Olaf
Geschrieben am: 07.09.2020 22:43:46
Hallo Karl-Heinz,
klappt Super, Danke.
könntest Du mir vielleicht nochmal helfen?, der Ausgabe Link nach Google müßte in UTF-8 codiert werden. das die Umlaute richtig angezeigt werden, sobald ein Umlaut übergeben wird, steht nichts im QR Code.
Gruß Olaf
von: volti
Geschrieben am: 07.09.2020 22:57:24
Hallo Olaf,
leider kenne ich mich derzeit damit nicht aus und müsste selber googlen, was da zu machen wäre.
Kann Dir da leider nicht helfen.
Wenn ich allerdings Müller eingebe, wird mir ein QR-Bild eingefügt....
viele Grüße
Karl-Heinz
von: volti
Geschrieben am: 08.09.2020 11:59:28
Hallo Olaf,
in u.a. Datei habe ich die wichtigsten Umlaute umgesetzt. Se werden jetzt in den QR-Code eingebaut und können gelesen werden.
Ob es eine elegantere Methode gibt, weiß ich leider zur Zeit auch nicht.
QR-Code
viele Grüße
Karl-Heinz
von: Olaf
Geschrieben am: 08.09.2020 15:37:26
Hallo Karl-Heinz,
klappt Super, Danke.
Gruß Olaf