|
|
成功了，下一步就是代码精简了。
简单介绍步骤：
1、遍历幻灯片，遍历图形。
2、判断：是图片的，提取图片的名称（arr）；是文本框的，提取文本框里面的内容（brr）。
3、判断：是图片的保存，这时暂时只能以图片的名称保存。
4、批量修改文件名：把图片文件的名称改成文本框里面的内容(arr变brr)。
最难处是批量修改文件名：
1、读取文件路径，mypath = "D:导出图片"。
2、读取文件名，myname = Dir(mypath & "*.jpg")。
3、修改文件名：Name myname1 As myname2。
读文件名时，我把“*”省略了，文件名没读出来。再次使用brr没数据了，只有从头读取。
- Sub SaveShape()
- Dim mySlide As Slide
- Dim myShape As Shape, i As Integer
- On Error Resume Next
- 'MkDir "D:导出图片"
- For Each sld In ActivePresentation.Slides
- For Each Shp In sld.Shapes
- If Shp.Type = msoTextBox Then
- brr = Shp.TextFrame.TextRange.Text
- s1 = brr
- Else
- If Shp.Type = msoPicture Then
- arr = Shp.Name
- s2 = arr
- i = i + 1
- 'MsgBox arr
- Shp.Export pathName:="D:导出图片" & arr & ".jpg", Filter:=ppShapeFormatGIF
- End If
- End If
- Next
- Next
- For Each sld In ActivePresentation.Slides
- For Each Shp In sld.Shapes
- If Shp.Type = msoTextBox Then
- brr = Shp.TextFrame.TextRange.Text
- mypath = "D:导出图片"
- myname = Dir(mypath & "*.jpg")
- If myname <> "" Then
- myname = Dir
- 'myname = brr
- Name mypath & myname As mypath & brr & ".jpg"
- End If
- End If
- Next
- NextEnd Sub
复制代码 |
|
