|
- Sub SaveShape1() '所有图形和图片
- Dim Sld As Slide
- Dim Shp As Shape
- 'On Error Resume Next
- For Each Sld In ActivePresentation.Slides
- For Each Shp In Sld.Shapes
- arr = Shp.Name
- sr = Dir("D:\导出图片", vbDirectory)
- If sr <> "" Then
- Shp.Export pathName:="D:\导出图片" & arr & ".jpg", Filter:=ppShapeFormatGIF
- Else
- MkDir "D:\导出图片"
- Shp.Export pathName:="D:\导出图片" & arr & ".jpg", Filter:=ppShapeFormatGIF
- End If
- Next
- Next
- End Sub
- Sub SaveShape2() '选择其中的一个
- Dim Shp As Shape
- On Error Resume Next
- Set Shp = ActiveWindow.Selection.ShapeRange(1)
- arr = Shp.Name
- sr = Dir("D:\导出图片", vbDirectory)
- If sr <> "" Then
- Shp.Export pathName:="D:\导出图片" & arr & ".jpg", Filter:=ppShapeFormatGIF
- Else
- MkDir "D:\导出图片"
- Shp.Export pathName:="D:\导出图片" & arr & ".jpg", Filter:=ppShapeFormatGIF
- End If
- End Sub
复制代码 |
|