Grafiken aus Tabelle per VBA in Datei(jpg) speich.

Ich habe hier ca. 500 Exceldateien, die alle gleich aufgebaut sind.
Also eine Tabelle mit Daten und jeweils einem Bild, das eingebettet ist.

Die Daten sollen alle in eine Exceldatei eingelesen werden. Da steht dann am eine eine Tabelle mit 500 Datensätzen.

Das soll ja auch nicht das Problem sein. Das bekomme ich mit VBA prima gelöst.

Aber das eingebettete Bild bereitet mir Probleme.

Wie bekomme ich das Bild aus der Tabelle raus und speichere es als jpg ab?
Aber jetzt nicht mit Vorschlägen ala Kopieren-Bildbearbeitungsprogramm öffnen-einfügen-abspeichern kommen. Das ist zu aufwändig und zu händisch.

Ich finde einfach keinen passenden Befehl dafür (immer nur zum Einfügen von Grafiken).

Ein Ansatz wäre evtl. der virtuelle Export der Datei als HTML, dann Bilder umbennen/verschieben, HTML und Unterordner löschen und nächste Datei anfassen.

Aber gehts nicht noch einfacher ?

Gruss
ixy
www.krambox.de

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo ?
Bilder exportieren geht so:


Option Explicit
Public Sub Export()
Dim intIndex As Integer
Dim myShape As Shape, mySheet As Worksheet, strMappenname As String, myChartObject As ChartObject
Application.ScreenUpdating = False
With Application.FileSearch
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = True ' wenn nötig
.LookIn = ThisWorkbook.Path 'hier und in der Export-Metode den Pfad anpassen
.Execute
For intIndex = 1 To .FoundFiles.Count
strMappenname = Right(.FoundFiles(intIndex), InStr(1, StrReverse(.FoundFiles(intIndex)), "\") - 1)
GetObject .FoundFiles(intIndex)
With Workbooks(strMappenname)
For Each mySheet In .Worksheets
For Each myShape In mySheet.Shapes
If myShape.Type = msoPicture Then
Set myChartObject = ThisWorkbook.Worksheets(1).ChartObjects.Add(0, 0, myShape.Width + 5, myShape.Height + 5)
myShape.Copy
myChartObject.Chart.Paste
myChartObject.Chart.Export Filename:=ThisWorkbook.Path & "\" & strMappenname & ".jpg", FilterName:="JPG"
myChartObject.Delete
End If
Next
Next
.Close False
End With
Next
End With
Application.ScreenUpdating = True
End Sub

Code eingefügt mit: Excel Code Jeanie

Die Anpassung schaffst du mit deinem VBA - Level sicher selbst.
Gruß
Nepumuk

P.S. Es wäre schön, wenn du einen richtigen Namen verwenden würdest. Auf Anfragen, deren Urheber nicht mal ihren Namen nennen können, antworte ich nur ausnahmsweise und in Zukunft überhaupt nicht mehr.

Beliebteste Forumthreads (12 Monate)

Grafiken aus Tabelle per VBA in Datei(jpg) speich.

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Grafiken aus Tabelle per VBA in Datei(jpg) speich.

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread