Excel如何使用VBA批量压缩图片？
1、打开Excel表格，点击【开发工具】、【Visual Basic】调出VBE编辑器。（也可以使用【Alt+F11】组合键调出VBE编辑器）
2、VBE编辑器的菜单栏上面点击【插入】、【模块】。
3、模块代码框里边输入以下VBA程序。
Sub Shapes_Zoom()
Dim Arr, Str1, Str2, Shp, myPath1, myPath2, MyPos, Na, i1, i2
On Error Resume Next '忽略运行中可能出现的错误
Application.ScreenUpdating = False '关闭工作表更新，提高运行速度
Application.DisplayAlerts = False '忽略报警提示
Arr = Array(".jpg", ".jpeg", ".png", ".bmp", ".gif", ".tif") '图片格式集合
myPath1 = "D:\ABCDE\" '源文件图片路径
myPath2 = "D:\ABCDE\FGH\" '压缩后图片导出路径
MkDir myPath2 '新建文件夹
Set mySheet1 = ThisWorkbook.Worksheets("Sheet1") '定义Sheet1工作表
Set fs = CreateObject("Scripting.FileSystemObject") '计算机文件访问
Set fo = fs.GetFolder(myPath1) '获取文件夹
Windows(1).Zoom = 100 '当前excel窗口放到到100%
For Each Shp In mySheet1.Shapes '对每张图片进行扫描，然后删除
Shp.Delete
Next
For Each fi In fo.Files '扫描文件夹里面的每一个文件
i1 = 0
i2 = 0
Na = fi.Name '获取文件名称
Do
i1 = MyPos '寄存上次获取“.”的位置
i2 = i2 + 1
MyPos = InStr(MyPos + 1, Na, ".") '获取"."存在的位置
If MyPos = 0 And i2 <> 1 Then
Str1 = Right(Na, Len(Na) - i1 + 1) '截取后缀名
Str2 = Left(Na, i1 - 1) '截取名称
If UBound(Filter(Arr, Str1)) = 0 Then '如果是图片格式的文件，则
mySheet1.Pictures.Insert(myPath1 & Na).Select '插入图片并选择
For Each Shp In mySheet1.Shapes '对每张图片进行扫描
Shp.LockAspectRatio = msoTrue '锁定图片的比例
Shp.ScaleHeight 0.5, msoTrue, msoScaleFromTopLeft '缩放50%
Next
For Each Shp In mySheet1.Shapes '对每张图片进行扫描
Shp.Copy '复制图片
Set Ch = mySheet1.Shapes.AddChart(1, 0, 0, 1, 1) '新建图表
Ch.Height = Shp.Height '图表高度=图片高度
Ch.Width = Shp.Width '图表宽度=图片宽度
Ch.Chart.Paste '把图片粘贴到图表里边
Ch.Fill.Visible = msoFalse '图表背景无填充
Ch.Line.Visible = msoFalse '图表边框无线条
Ch.Chart.Export myPath2 & Na '导出压缩图片
Ch.Delete '删除图表
Shp.Delete '删除图片
Application.CutCopyMode = False '清空剪切板
Next
End If
Exit Do '退出Do循环
End If
Loop
Next
Application.CutCopyMode = False '清空剪切板
Application.DisplayAlerts = True '恢复报警提示
Application.ScreenUpdating = True '恢复更新显示
End Sub
4、检查确认无误后，功能区里边点击“运行”图标运行程序。
5、程序运行完成后，打开压缩图片存放的文件夹。
6、将会看到图片已经被批量压缩。
1、VBA程序思路分享、解读：
1、先建立一个图片格式的集合Array(".jpg", ".jpeg"……)，便于后续判断该文件是否属于图片格式，如果不是图片格式，则不用插入Excel表格，也就不用压缩了。
2、对Sheet1里面所有的图片删除，主要是避免干扰，同时，导出完成之后，再将图表和图片删除，以避免Excel文件过大而停止运行。
3、获取文件格式，主要是通过截取文件名最后一个点号（.）及之后的字符，再与图片格式集合比对。如果是图片格式，则UBound(Filter(Arr, Str1))为0，否则为-1。
4、Excel表格里面的图片不能直接导出，但可以通过图表的形式将其导出。
