|
Hallo liebe Community,
ich habe folgenden Code aus einem Hilfe-Forum abgeguckt und er funktioniert eigentlich perfekt.
Leider werden jedoch in meinem Workbook alle Grafiken, also auch von anderen Sheets gespeichert. Ich würde jedoch gerne nur das Chart auf einem einzigen Sheet speichern lassen.
Hat jemand eventuell eine Lösung für mich? Möglicherweise sogar mit dem Zusatz, dass die gespeicherten Sheets als Endung eine fortlaufende Nummerierung erhalten. Das wäre natürlich noch ein Schmankerl. Denn so müsste man das gespeicherte Chart nicht mehr mühselig umbennenen, bevor man ein weiteres Speichern kann.
Ich bin dankbar für jede Hilfe.
LG, Jim
Hier der Code:
Sub Chart_SavetoJPG()
Dim objShell As Object
Dim objWindowsFolder As Object
Dim strWindowsFolder As String
Dim objSheet As Excel.Worksheet
Dim objChartObject As ChartObject
Dim objChart As Excel.Chart
'Select a Windows folder
Set objShell = CreateObject("Shell.Application")
Set objWindowsFolder = objShell.BrowseForFolder(0, "Select a Windows folder:", 0, "")
If Not objWindowsFolder Is Nothing Then
strWindowsFolder = objWindowsFolder.self.Path & "\"
For i = ThisWorkbook.Worksheets.Count To 1 Step -1
Set objSheet = ThisWorkbook.Worksheets(i)
If objSheet.ChartObjects.Count > 0 Then
For Each objChartObject In objSheet.ChartObjects
Set objChart = objChartObject.Chart
objChart.Export strWindowsFolder & objChart.Name & ".jpg"
Next
End If
Next
'Open the windows folder
Shell "Explorer.exe" & " " & strWindowsFolder, vbNormalFocus
End If
End Sub |