ich würde mich über eure Hilfe bei einem VBA-Code freuen. Eine Beispiel-Datei habe ich angehängt.
Das Makro soll diverse Bilder aus der Excel-Datei erstellen und diese unter einem Windows-Pfad als jpg-Datei abspeichern. Die Bereiche, welche als Bild exportiert werden sollen, habe ich jeweils grün markiert. Der Name für die Bilder ist in Spalte E vorgegeben. Hilfsweise habe ich eine Spalte G mit dem Pfad eingefügt, da ich es im Makro nicht anders gelöst bekommen habe: Bild aus Bereich B1:C2, Name in E1 bzw. Pfad in G1 Bild aus Bereich B4:C5, Name in E4 bzw. Pfad in G4 usw.
Ich habe Probleme bei der Schleife. Testweise lasse ich die Schleife zunächst 2x durchlaufen. Es wird aber nur ein Bild erstellt und unter dem Windows-Pfad gespeichert. Weitere Bilder werden im Blatt selbst erstellt. Das ist nicht so gewollt. Später soll die Anzahl für i aus der Zelle F1 entnommen werden.
Ich freue mich über Tipps und Verbesserungsvorschläge.
Was bedeutet die 12 in der Spalte A, die pro .jpg (QR Code) ersichtlich ist? Warum ist das .jpg in einer eigenen Zeile und nichtin der nächsten Spalte in der selben Zelle? Wie möchtest du die .jpg identifizieren die exportiert werden sollen? -> eine grüne Hintergundfarbe ist nicht die beste Idee.... -> ist eventuell die 12 der marker? Ändert sich der genannte Pfad in F2 (20241011_Homezone_Bilder_VBA) imnächsten Monat, nächsten Jahr? Was soll den Export auslösen? Soll beim Export geprüft werden, od die Exportdatei bereits im Ordner existiert?
Die „12“ in Spalte A hat keine Bedeutung für den VBA-Code. Die 12 ist lediglich dafür da, damit in Spalte B die jeweilige Zeile immer gleich hoch ist. Daher „1 [Zeilenumbruch] 2“.
Das jpg (der QR Code) ist in einer weiteren Zelle, da die weiteren Informationen drum herum benötigt werden.
Die zu exportierenden Bilder folgen genau dem bereits beschrieben Muster: Bild 1 aus Bereich B1:C2 Bild 2 aus Bereich B4:C5 usw. Die Färbung in grün habe ich nur hilfsweise eingefügt.
Der Pfad ändert sich nicht.
Den Export möchte ich manuell anstoßen ( [ALT]+[F8] reicht).
Die Prüfung, ob die Datei bereits existiert ist nicht so wichtig. Nur, falls es sehr einfach möglich wäre. Ansonsten kann darauf auch ohne weiteres verzichtet werden.
Danke für die Antwort. Das "drum herum" werde ich alles in einer Zeile (also 1 Teile pro .jpg) umstellen. -> Deswegen 1e Zeile, da leichter und ich mir aus Erfahrung denke, dass noch Fragen, Ideen, wünsche auftauchen an die du jetzt noch nicht denkst. Das ist der ganz gewöhnliche Lauf der VBA-Dinge.... Als Trigger werde ich dir einen Command-Button in das Arbeitsblatt einfügen. Ich schaffe es jedoch nicht vor heute Abend, morgen früh
12.10.2024, 09:56 (Dieser Beitrag wurde zuletzt bearbeitet: 12.10.2024, 10:02 von Egon12.)
Hallo miteinander,
es geht doch recht simpel zu lösen. Ein Shape auf direkten Weg zu exportieren geht nur in Word aber nicht in Excel. Hier muss der Weg über ein Diagrammgrafikobjekt gegangen werden, welches man temporär erzeugt -->exportiert --> löscht.
Dein Lösungsweg wäre dann so:
Code:
Option Explicit Private Const ZielPfad As String = "C:\Users\...\" ' Hier den Zielpfad anpassen Sub BilderExportieren() Dim objShape As Shape, objChart As ChartObject, adrCell$ For Each objShape In Tabelle1.Shapes adrCell$ = objShape.TopLeftCell.Cells.Address If Range(adrCell$).Offset(-1, 0).Interior.Color = RGB(0, 176, 80) Then objShape.CopyPicture Appearance:=xlScreen, Format:=xlPicture Set objChart = ActiveSheet.ChartObjects.Add(0, 0, objShape.Width, objShape.Height) With objChart.Chart .Paste .Export Filename:=ZielPfad & Range(adrCell$).Offset(-1, 3) End With End If objChart.Delete Next End Sub
In deiner Beispieldatei läuft dieser Code am Ende in einen Fehler, da sich ein leeres Shape drin befindet. Dieses löscht du falls dies auch in der Originaldatei vorhanden ist händisch einfach mal raus und dann klappt es auch störungsfrei mit dem Export ohne On Error. Ach ja, in den Zellen wo die Dateinamen drin stehen fehlt teilweise .jpg. Dies muss du auch korrigieren.
Gruß Uwe Hab noch was vergessen. Das zusammensetzen des Speicherpfades in Spalte F und G brauchst du wahrscheinlich eher nicht. Dies habe ich in der Prozedur deshalb auch ignoriert. Ich gehe mal davon aus, dass du die Grafiken in ein Verzeichnis haben möchtest.
da war noch ein kleiner Lapsus drin --> ändere die Prozedur so:
Code:
Sub BilderExportieren() Dim objShape As Shape, objChart As ChartObject, adrCell$ For Each objShape In Tabelle1.Shapes adrCell$ = objShape.TopLeftCell.Cells.Address If Range(adrCell$).Offset(-1, 0).Interior.Color = RGB(0, 176, 80) Then objShape.CopyPicture Appearance:=xlScreen, Format:=xlPicture Set objChart = ActiveSheet.ChartObjects.Add(0, 0, objShape.Width, objShape.Height) With objChart.Chart .Paste .Export Filename:=ZielPfad & Range(adrCell$).Offset(-1, 3) End With objChart.Delete End If Next End Sub
Das kann sonst in einen Fehler laufen, wenn die Zelle über dem Shape nicht grün gefärbt ist und damit der Export ausgeschlossen werden soll.
mal noch ein Hinweis. Bei dieser Methode behält Excel Reste im Arbeitsspeicher, was mit der Zeit zum Abbruch führen kann. Könnte sein, dass Du den Bilderexport bei einer großen Anzahl Bilder zwischendurch unterbrechen und Excel beenden musst. Ich hatte so ab ca 70 Bildern Probleme.
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
12.10.2024, 12:39 (Dieser Beitrag wurde zuletzt bearbeitet: 12.10.2024, 12:58 von Egon12.)
Hallo,
ich habe auch eben festgestellt, dass es Probleme beim Durchlauf gibt. Ich denke mal da bleibt nur der Weg, falls es da was Bekanntes gibt, über eine API Funktion. Da habe ich mich an der Stelle aber noch nie mit Shapes + API beschäftigt. Vielleicht kann da Volti (der steckt in solchen Sachen richtig gut und tief drin) dir da weiterhelfen. So wie ich es dir gezeigt habe ist es nicht zuverlässig.
Gruß Uwe jetzt habe ich mal den kritischen Teil in eine zweite Prozedur gepackt --> die Variablen modulweit angelegt und mit Application.OnTime diese aufgerufen. Da streikt das Chartobjekt nach einem Durchlauf.
Auch der Versuch das Chartobjekt auf Nothing zu setzen brachte nichts. Es scheint richtig heftig über OnTime abzustürzen, da VBA einfach stehenbleibt.
Ohne OnTime läuft das Ganze durch, aber mit den besprochenen Macken.
12.10.2024, 15:12 (Dieser Beitrag wurde zuletzt bearbeitet: 12.10.2024, 15:13 von knobbi38.)
Hallo Uwe,
das mit dem OnTime kannst du vergessen, was soll das bewirken? Du kannst höchstens versuchen, am Ende der Schleife ein DoEvents einzubauen, um VBA Gelegenheit zu geben, anstehende Events abzuarbeiten.
Eine andere Idee könnte z.B. sein, das Shape mit CopyPicture in die Zwischenablage zu kopieren, dann dieses mit dem Clipboardformat CF_BITMAP wieder in ein IPictureDisp einzulesen und anschließend mit stdole.SavePicture als *.BMP zu speichern. Eventuell könnte man auch IPictureDisp in ein Byte-Array einlesen, dieses dann per WIA in ein anderes Format konvertieren und danach abspeichern.
