单独压缩一两张图片，可以通过Excel表格手动缩放，或者通过其他软件进行缩放。如果要压缩的图片较多，通过手动压缩的方法就比较费劲，此时可以通过VBA程序进行压缩。
工具/原料
操作硬件：计算机
操作系统：Windows7
办公软件：Excel2010
方法/步骤
1、打开Excel表格，点击【开发工具】、【VisualBasic】调出VBE编辑器。（也可以使用【Alt+F11】组合键调出VBE编辑器）
2、VBE编辑器的菜单栏上面点击【插入】、【模块】。
3、模块代码框里边输入以下VBA程序。SubShapes_Zoom()DimArr,Str1,Str2,Shp,myPath1,myPath2,MyPos,Na,i1,i2OnErrorResumeNext'忽略运行中可能出现的错误Application.ScreenUpdating=False'关闭工作表更新，提高运行速度Application.DisplayAlerts=False'忽略报警提示Arr=Array(".jpg",".jpeg",".png",".bmp",".gif",".tif")'图片格式集合myPath1="D:\ABCDE\"'源文件图片路径myPath2="D:\ABCDE\FGH\"'压缩后图片导出路径MkDirmyPath2'新建文件夹SetmySheet1=ThisWorkbook.Worksheets("Sheet1")'定义Sheet1工作表Setfs=CreateObject("Scripting.FileSystemObject")'计算机文件访问Setfo=fs.GetFolder(myPath1)'获取文件夹Windows(1).Zoom=100'当前excel窗口放到到100%ForEachShpInmySheet1.Shapes'对每张图片进行扫描，然后删除Shp.DeleteNextForEachfiInfo.Files'扫描文件夹里面的每一个文件i1=0i2=0Na=fi.Name'获取文件名称Doi1=MyPos'寄存上次获取“.”的位置i2=i2+1MyPos=InStr(MyPos+1,Na,".")'获取"."存在的位置IfMyPos=0Andi2<>1ThenStr1=Right(Na,Len(Na)-i1+1)'截取后缀名Str2=Left(Na,i1-1)'截取名称IfUBound(Filter(Arr,Str1))=0Then'如果是图片格式的文件，则mySheet1.Pictures.Insert(myPath1&Na).Select'插入图片并选择ForEachShpInmySheet1.Shapes'对每张图片进行扫描Shp.LockAspectRatio=msoTrue'锁定图片的比例Shp.ScaleHeight0.5,msoTrue,msoScaleFromTopLeft'缩放50%NextForEachShpInmySheet1.Shapes'对每张图片进行扫描Shp.Copy'复制图片SetCh=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.ExportmyPath2&Na'导出压缩图片Ch.Delete'删除图表Shp.Delete'删除图片Application.CutCopyMode=False'清空剪切板NextEndIfExitDo'退出Do循环EndIfLoopNextApplication.CutCopyMode=False'清空剪切板Application.DisplayAlerts=True'恢复报警提示Application.ScreenUpdating=True'恢复更新显示EndSub
4、检查确认无误后，功能区里边点击“运行”图标运行程序。
5、程序运行完成后，打开压缩图片存放的文件夹。
6、将会看到图片已经被批量压缩。
VBA程序解读
1、VBA程序思路分享、解读：先建立一个图片格式的集合Array(".jpg",".jpeg"……)，便于后续判断该文件是否属于图片格式，如果不是图片格式，则不用插入Excel表格，也就不用压缩了。对Sheet1里面所有的图片删除，主要是避免干扰，同时，导出完成之后，再将图表和图片删除，以避免Excel文件过大而停止运行。获取文件格式，主要是通过截取文件名最后一个点号（.）及之后的字符，再与图片格式集合比对。如果是图片格式，则UBound(Filter(Arr,Str1))为0，否则为-1。Excel表格里面的图片不能直接导出，但可以通过图表的形式将其导出。
