user_lwdafvuu 发表于 2016-4-12 13:34:07

求助，导出图片


求助，如何导出图片并以对应文本框内容命名图片

user_wwwip 发表于 2016-4-12 14:34:59

没有人啊，不能沉，希望vba解决

pengshu 发表于 2016-4-12 17:17:05

太难，图片对，名称就不对，名称对，图片就不对。先弄到这，吃饭。
[*]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
[*]Else
[*]If Shp.Type = msoPicture Then
[*]      arr = Shp.Name
[*]      i = i + 1
[*]      'MsgBox arr
[*]      Shp.Export pathName:="D:导出图片" & arr & ".jpg", Filter:=ppShapeFormatGIF
[*]End If
[*]End If
[*]Next
[*]NextEnd Sub

复制代码

☆☆☆光璀璨 发表于 2016-4-12 18:10:20

成功了，下一步就是代码精简了。
简单介绍步骤：
1、遍历幻灯片，遍历图形。
2、判断：是图片的，提取图片的名称（arr）；是文本框的，提取文本框里面的内容（brr）。
3、判断：是图片的保存，这时暂时只能以图片的名称保存。
4、批量修改文件名：把图片文件的名称改成文本框里面的内容(arr变brr)。
最难处是批量修改文件名：
1、读取文件路径，mypath = "D:导出图片"。
2、读取文件名，myname = Dir(mypath & "*.jpg")。
3、修改文件名：Namemyname1 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 <> &quot;&quot; Then
[*]myname = Dir
[*]      'myname = brr
[*]Name mypath & myname As mypath & brr & &quot;.jpg&quot;
[*] End If
[*] End If
[*] Next
[*] NextEnd Sub

复制代码
页: [1]
查看完整版本: 求助，导出图片