大神请帮忙，如何把B列的图片导出来并按照A列命名，求导出高清大图，跪求

ys123456 · 发表于 2017-6-14 16:41

我想把B列的图片按照A列的文字命名，并且导出到同一个文件夹里，希望导出来高清大图，大神们帮帮忙，跪请大神！

xtpdcyga · 发表于 2017-6-15 20:16

Sub sExportShp2GIF()
Dim objShp As Shape, H, W, sku
Dim i As Integer
Dim c As ChartObject
For i = 1 To ActiveSheet.Shapes.Count
      Set objShp = ActiveSheet.Shapes(i)
      sku = ActiveSheet.Cells(objShp.TopLeftCell.Row, objShp.TopLeftCell.Column - 1)
      W = objShp.Width
      H = objShp.Height
      objShp.Width = 768
      objShp.Height = 768

      objShp.CopyPicture
      Set c = ActiveSheet.ChartObjects.Add(0, 0, objShp.Width, objShp.Height)
      c.Activate
      c.Chart.Paste
      c.Chart.Export ThisWorkbook.Path & "\" & sku & ".jpg"
      c.Delete
      objShp.Width = W
      objShp.Height = H
Next i
Set objShp = Nothing
End Sub

ys123456 · 发表于 2017-6-16 14:53

xtpdcyga 发表于 2017-6-15 20:16
Sub sExportShp2GIF()
Dim objShp As Shape, H, W, sku
Dim i As Integer

亲，请查看附件，这是怎么回事

xtpdcyga · 发表于 2017-6-17 08:31

我电脑上执行一点问题都没有，你的EXCEL是什么版本的？

cdwoodways · 发表于 2020-2-8 23:03

本帖最后由 cdwoodways 于 2020-2-9 00:36 编辑

xtpdcyga 发表于 2017-6-17 08:31
我电脑上执行一点问题都没有，你的EXCEL是什么版本的？

厉害，学习了，数据多了运行还是有点问题，求解决

cdwoodways · 发表于 2020-3-6 03:07

同问，我也是1004问题

Excel__Boy · 发表于 2020-3-6 16:45

Sub main()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
shp.Copy
With ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart
.Parent.Select
.Paste
.Export "d:" & shp.TopLeftCell.Offset(0, 1) & ".png"
.Parent.Delete
End With
Next shp
End Sub

复制代码

		自动登录	找回密码
密码			免费注册