Question

我的公司正在尝试将800个图像从excel（每个都在自己的行中）导出到计算机上的文件夹中。我们希望每个文件名与从中拉出的行相同（1.png，2.png等..）。

我已经检查过这样做的脚本但到目前为止我只看到了一个关于从URL中提取图片的脚本。我并不像我一样熟悉excel。

只要我们可以拥有每个图像的本地副本，这些副本可以很容易地通过我们将它们从哪一行中识别出来，那么无论采用何种方法，它都是成功的。

我们正在这样做，以便我们可以批量导入/上传到AirTable。

以下示例链接：这只有1个样本，但整个文档中有超过800行。

https://drive.google.com/file/d/0B8klLazhe0NTMWZZS01kRkNHZ1U/view?usp=sharing

我感谢任何可能的帮助。谢谢，

Answer 1

我必须做同样的事情。这是我用过的改编。我假设你的照片在第一张纸上，如果没有改变它。您还应该将路径更改为您希望保存所有图像的位置：

Option Explicit


Public Sub ExportAllPics()
  Dim shp As Shape
  Dim path As String: path = "C:\Temp\"
  Dim cnt As Integer: cnt = 1

  Application.DisplayAlerts = False

  With Sheets(1)
    For Each shp In .Shapes
      If shp.Type = msoPicture Then
        shp.Copy
        With Charts.Add
          .Paste
          .Export Filename:=path & CStr(cnt) & ".jpg", FilterName:="jpg"
          .Delete
        End With
        cnt = cnt + 1
      End If
    Next
  End With

  Application.DisplayAlerts = True

End Sub

这类似于其中一条评论中提供的链接，它设置了一个图表，将图像复制到它并将图表导出为jpeg文件（这是我设法使这项工作成功的唯一方法 - 也许其他人会发布一个将图像直接复制到文件的解决方案。设置的图表是用于导出的临时图表，会立即删除。必须禁用显示警报，否则将为每个图表删除弹出一个消息框。

修改

以下是上述的变体。每张图片被复制（临时到单元格A1），缩放，复制到剪贴板（之后A1中的临时图片被删除），从剪贴板添加到新清除的图表然后导出：

Option Explicit Public Sub ExportAllPics2() Dim shp As Shape Dim path As String: path = "C:\Temp\" 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) & ".jpg", FilterName:="jpg" .Delete End With cnt = cnt + 1 End If Next End With Application.DisplayAlerts = True End Sub

如果工作表中的每张图片的高度/宽度比都可以，那么您应该能够通过锁定纵横比将它们缩放到合适的大小。不幸的是，我使用的工作簿上有尺寸失真的图片，因此我将高度/宽度设置为标准尺寸 - 结果是大多数图片看起来都合适，但有一些例外。

Answer 2

Excel解析器处理器是一个基于开源电子的项目，我开始帮助一个朋友下载excel文件列中列出的大量图像。它现在可以下载和重命名，但时间可能会变好。可以在github的我的仓库中结帐。

将多个图像从excel行保存到计算机

2 个答案: