有没有一种方法可以从Excel下载图像并根据另一个单元格中的数据命名它?

时间:2020-01-25 09:12:29

标签: excel vba

我有一个Excel,其中A列中可能有或没有图像,而B列中有数字。我希望将这些图像下载到一个文件夹中,并按照B列中的相应条目进行命名。

我尝试了以下代码,但它正在下载纯白色图像,并命名为图像1,图像2等。

Option Explicit
Public Sub ExportAllPics2()
  Dim shp As Shape
  Dim path As String: path = "C:\Images\"
  Dim cnt As Integer: cnt = 1
  Application.DisplayAlerts = False
  With Sheets(1)
    For Each shp In .Shapes
      If shp.Type = msoPicture Then
        shp.Copy
        .Range("A1").Select
        .Paste
        With Selection
          .Height = 600
          .Width = 400
          .Copy
          .Delete
        End With
        With Charts.Add
          .ChartArea.Clear
          .Paste
          .Export Filename:=path & CStr(cnt) & ".png", FilterName:="png"
          .Delete
        End With
        cnt = cnt + 1
      End If
    Next
  End With
  Application.DisplayAlerts = True
End Sub

enter image description here

1 个答案:

答案 0 :(得分:0)

提供的图像跨度不超过1行,您可以使用shape对象的.TopLeftCell和.BottomRightCell属性。

For Each shp In .Shapes
  If shp.Type = msoPicture Then

    If shp.TopLeftCell.Row <> shp.BottomRightCell.Row Then
      MsgBox "Warning shape spans 2 rows at row " & shp.TopLeftCell.Row
    End If

   .. your existing code

      .Export Filename:=path & shp.TopLeftCell.Offset(0, 1) & ".png", FilterName:="png"