Hi!
Ich habe ein Bild (als Shape) in einer Exceltabelle. Gibt es eine Möglichkeit dieses via VBAMakro in eine Datei zu speichern?
Mit freundlichen Grüßen, Andi
Hallo Andi,
im Prinzip:
'objShape ist das zu exportierende shape
'davon eine Kopie in die Zwischenablage
objShape.CopyPicture Appearance:=2, Format:=-4147
'Auf einem Arbeitsblatt muss ein ChartObject (Diagramm) existieren
'das dient dem späteren Export
Set objChartObject = myTable.ChartObjects(1)
'das soll so groß sein, wie das shape damits auch reinpasst
objChartObject.Width = objShape.Width
objChartObject.Height = objShape.Height
'ggfs. alte Shapes in dem chart löschen
While objChartObject.Chart.Shapes.Count \> 0
objChartObject.Chart.Shapes(1).Delete
Wend
'Kopie des Shape da reinkopieren
objChartObject.Chart.Paste
'chart exportieren, ggfs den Pfad und namen per Dialog abfragen
objChartObject.Chart.Export Filename:=ThisWorkbook.Path & "\MeinExport.jpg", \_
FilterName:="JPG", Interactive:=False
mfg
Dirk.Pegasus
Hi Dirk!
Danke für deine Lösung, funktioniert einwandfrei.
Ich habs auch geschafft, aber um einiges komplizierter, da ist deine Lösung besser!
'Bild in PowerPoint laden und speichern (weil Excel zu blöd dafür ist ^^)
Dim appPP As New PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
appPP.Activate
Set PPPres = appPP.Presentations.Add
Set PPSlide = PPPres.Slides.Add(PPPres.Slides.Count + 1, ppLayoutBlank)
appPP.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
'Größe der Folie ändern, weil PowerPoint ansonsten den weißen Hintergrund mitspeichert
With PPPres.PageSetup
.SlideSize = ppSlideSizeCustom
.SlideWidth = Image1.Width
.SlideHeight = Image1.Height
.FirstSlideNumber = 1
.SlideOrientation = msoOrientationHorizontal
.NotesOrientation = msoOrientationVertical
End With
appPP.ActiveWindow.View.Paste
appPP.ActiveWindow.View.Zoom = 100
appPP.ActiveWindow.Selection.SlideRange.Shapes(1).Select
PPPres.SaveAs Filename:=„C:\Bild1.bmp“, FileFormat:=ppSaveAsBMP, EmbedTrueTypeFonts:=msoFalse
DoEvents
'Ist nötig weil PowerPoint zu blöd ist die Datei unter dem angegebenen Namen zu speichern ^^
FileCopy „C:\Bild1\Folie1.bmp“, „C:\Bild1.bmp“
Kill „C:\Bild1\Folie1.bmp“
RmDir „C:\Bild1“
appPP.DisplayAlerts = ppAlertsNone
appPP.Quit
Set PPSlide = Nothing
Set appPP = Nothing
MfG, Andi