使用VBA获取图片信息

如下图所示，要从“D:\ABC”文件夹里边获取所有图片的文件信息（如：文件名、文件类型、大小、像素尺寸等）填入Sheet1工作表。如果纯手动输入将会比较费时，图像文件较多时将无法按时完成，使用VBA程序自动录入就会便捷很多，也省时省力。

工具/原料

• 计算机

• Windows 7

• Excel 2010

方法/步骤

1. 1

   打开Excel表格之后，按下【Alt+F11】组合键打开VBA编辑器。

   
2. 2

   在VBA编辑器的菜单栏上面点击【插入】、【模块】。

   
3. 3

   在“模块”的代码窗口里边输入以下VBA程序，然后按下【F5】键运行程序。

   Sub GetPicturesInfo()

   Dim fs, fo, fi, str, i, picture

   Application.ScreenUpdating = False   '关闭屏幕更新以提高宏的运行速度

   On Error Resume Next                 '忽略运行过程中可能出现的错误

   i = 1                                'i初始化，从第二行开始

   Set mysheet1 = ThisWorkbook.Worksheets("Sheet1")     '定义Sheet1工作表

   Set mysheet2 = ThisWorkbook.Worksheets("Sheet2")     '定义Sheet1工作表

   Set fs = CreateObject("Scripting.FileSystemObject")  '创建并返回对计算机系统文件的访问

   Set fo = fs.Getfolder("D:\ABC\")  '定义文件夹，“ABC”为D盘下边的文件夹

   Set fi = fo.Files                 '定义文件夹下边所有文件集

   For Each picture In fi   '获取文件夹里面所有的文件

     i = i + 1              '每执行一次循环递增1行

     mysheet1.Cells(i, 1) = picture.Name  '图片名称

     mysheet1.Cells(i, 2) = picture.Type  '图片类型

     mysheet1.Cells(i, 3) = Application.WorksheetFunction.RoundUp((picture.Size) / 1024, 0) & " KB"

     '图片大小，把字节转换成k并向上舍入并保留整数

     mysheet1.Cells(i, 5) = picture.DateLastModified  '最后的图片更改日期

     mysheet1.Cells(i, 6) = picture.DateCreated       '图片的创建时间

     mysheet2.Pictures.Delete         '删除Sheet2上面所有的图片

     str = "D:\ABC\" & picture.Name   '图片文件路径

     mysheet2.Pictures.Insert (str)   '插入图片

     mysheet2.Pictures.ShapeRange.ScaleHeight 1, msoTrue, msoScaleFromTopLeft

     '对插入的图片100%按照原图放大

      If picture.Type = "PNG 文件" Or picture.Type = "GIF 图像" Then

      '如果是"PNG 文件"或 "GIF 图像"文件，则需要除以0.75，以免像素对不上

       mysheet1.Cells(i, 4) = Round(mysheet2.Pictures.Width / 0.75) & _

       " x " & Round(mysheet2.Pictures.Height / 0.75)

      Else

       mysheet1.Cells(i, 4) = Round(mysheet2.Pictures.Width) & _

       " x " & Round(mysheet2.Pictures.Height)

      End If

       mysheet2.Pictures.Delete

   Next

   Application.ScreenUpdating = True  '恢复屏幕更新

   End Sub

   
4. 4

   程序的运行结果如下图所示。

   
5. 5

   程序函数、思路解读：

   （1）使用VBA访问计算机文件系统信息，需要用到“CreateObject("Scripting.FileSystemObject")”，然后逐层去查找、访问。

   （2）“For Each picture In fi”是对文件夹里边的每一个文件逐一扫描，然后再获取相关的信息。（picture代表fi文件集里边的其中一员）

   （3）Size获取的图片大小是字节（Byte），此时需要把它除以1024转换成KB，再使用“ROUNDUP”向上取整才能接近于电脑上面显示的图像大小。

   （4）由于没法直接从电脑上面获取图片的像素信息，只能把它插入Excel表格，按原图100%放大之后获取它的像素信息。（Sheet2是临时使用的表格，里边不要放有图片文件，以免全部被删除）

   （5）获取的像素信息可能不是整数，所以就通过“Int”取整函数进行取整。

   
6. 6

   程序运行调试：

   程序调试是写程序时不可或缺的一步，对程序代码不熟悉，可以边写边调试，发现错误的同时也能够加深印象。

   （1）调试程序时，先把“Application.ScreenUpdating = False”、“On Error Resume Next”等可能影响程序调试的屏蔽掉；

   （2）点击VBA编辑器菜单栏上面的【视图】，【本地窗口】，然后按下【F8】键逐一运行程序，在“本地窗口”及工作表上面查看执行的结果，更正程序中存在的不足。

   
   
   END

注意事项

• 个人经验，仅供参考；如有疑问，欢迎提出。