|
Hallo Zusammen,
ich suche schon seit 6 Stunden vergebens eine Möglichkeit, wie ich ein Textfeld mit Hilfe von VBA als PNG-Grafik speichern kann.
Ich habe verschiedene Varianten ausprobiert.
Ich bekomme allerdings immer diverse Fehlermeldungen.
Hier meine Varianten:
Variante 1
Sub Export_Images()
Dim Destination_Folder As String
Dim sld As Slide
Dim shp As Shape
Destination_Folder = "C:\Test"
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.Type = msoTextBox Then
shp.Export Destination_Folder & shp.Name & ".GIF", ppShapeFormatGIF
End If
Next shp
Next sld
End Sub
Fehlermeldung:
Variante 2:
Sub ExtractImagesFromPres()
On Error GoTo ErrorExtract
Dim oSldSource As Slide
Dim oShpSource As Shape
Dim Ctr As Integer
Dim sPath As String
sPath = "C:\"
Ctr = 0
For Each oSldSource In ActivePresentation.Slides
For Each oShpSource In oSldSource.Shapes
If oShpSource.Type = msoTextBox Then
' Hidden Export method
Call oShpSource.Export(sPath & "Img" & _
Format(Ctr, "0000") & ".PNG", ppShapeFormatPNG)
Ctr = Ctr + 1
End If
Next oShpSource
Next oSldSource
If Ctr = 0 Then
MsgBox "There were no images found in this presentation", _
vbInformation, "Image extraction failed."
End If
Exit Sub
ErrorExtract:
If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical, "Error #" & Err.Number
End If
End Sub
Fehlermeldung:
Variante 3:
Public Sub SaveAsPicture_Example()
'ThisDocument.Pages(1).Shapes(1).SaveAsPicture "filename.jpg"
'Call ActiveWindow.Selection.ShapeRange(1).Export("C:\filename.gif", ppShapeFormatGIF)
Dim myGroup As ShapeRange
Set myGroup = ActivePresentation.Slides(1).Shapes.Range(1)
myGroup.Export "C:\Test.png", ppShapeFormatPNG
End Sub
Fehlermeldung:
Ich hoffe ihr könnt mir helfen :)
|