本次案例来自网友提问:需要从600个Excel文件中导出每个文件中的2个图片，之前由于时间原因，回复比较简单没有给出具体实现方法，今天花时间整理写成图文，希望小伙伴们都可以学会。一、 数据模拟为了更加真实的还原提问者遇到的问题，我们需要准备600个且都包含有2个图片的Excel文件。一两个文件我们可以手动新建就可以了，这可是600个文件呐！别担心，既然我们是用VBA来解决问题，解决这种事情重复机械的劳动，当然不是什么难事。图片我们用以下两个代替，放到当前文件目录下，分别命名为test1.png和test2.png，模拟数据时将test1.png插入到第一个表,test2.png插入到第二个工作表。test1.pngtest2.png分步操作过程:第一步:新建一个Excel文件，将它另存为.xlsm格式。启用宏工作簿第二步:打开新建好的.xlsm文件，按快捷键ALT+F11进入VBE界面。进入VBE界面第三步:在VBE工程种插入一个模块。插入模块第四步:在刚刚新建的模块中粘贴以下代码。Sub 生成600个含图片的Excel文件()'关闭刷新，防止屏幕抖动Application.ScreenUpdating = False'定义变量iDim i As Integer'定义i从1循环到600For i = 1 To 600'新增一个工作簿Workbooks.Add'往工作簿的第一个工作表中插入图片test1.pngActiveWorkbook.Sheets(1).Pictures.Insert(ThisWorkbook.Path & \test1.png).Select'往工作簿的第二个工作表中插入图片test2.pngActiveWorkbook.Sheets(2).Pictures.Insert(ThisWorkbook.Path & \test2.png).Select'将工作簿存储到当前路径下ActiveWorkbook.SaveAs ThisWorkbook.Path & \ & i & .xlsx'关闭工作簿ActiveWorkbook.Close'继续循环新建其他工作簿Next'恢复屏幕刷新Application.ScreenUpdating = True'处理完成给出提示MsgBox 600个含图片的Excel文件生成完成！, vbInformation, 提示信息End Sub第五步:执行VBA代码，生成我们需要的600个Excel文件。执行VBA代码连贯操作演示:操作演示二、 图片导出600个案例文件已经准备好了，接下来就是导出文件中的图片。解决思路:1. 一个个的找出当前目录下的所有Excel文件。2. 打开找到的Excel文件。3. 一个个的找出Excel文件中的工作表。4. 找出工作表中的所有图片对象。5. 把找到的每一个图片导出到当前目录下。如果文件不多的情况下，按上面的思路手动操作导出也是可以的，其实通过VBA来解决问题也是要先把复杂问题进行简单化，一步步进行分解问题，最终形成完整解决方案。VBA代码使用方式在上面数据准备过程中已经有详细描述了，本次我们直接来运行下代码，实现导出文件中的图片。Sub 导出当前路径下工作簿中的图片()Dim wk$ '定义为工作簿文件Dim i As Integer '定义工作簿中的工作表数量Dim ii As Integer '定义为工作表中的对象个数'关闭刷新，防止抖动Application.ScreenUpdating = False'遍历第一个工作簿文件wk = Dir(ThisWorkbook.Path & \*.xlsx)'遍历到的文件名不等于空的情况下Do While wk <> '如果文件名称和当前的名称是不一样的。If wk <> ThisWorkbook.Name Then'打开遍历到的工作簿Workbooks.Open (ThisWorkbook.Path & \ & wk)'对打开的工作簿文件进行以下操作With ActiveWorkbook'循环出工作簿中的每一个工作表For i = 1 To .Sheets.Count'循环出工作表中的每一个对象shapeFor ii = 1 To .Sheets(i).Shapes.Count'临时变量，统计shape的个数k = k + 1'复制shape对象.Sheets(i).Shapes(ii).Copy'创建一个图表对象，宽高与与对象保持一致With .Sheets(i).ChartObjects.Add(0, 0, .Sheets(i).Shapes(ii).Width, .Sheets(i).Shapes(ii).Height).Chart'把图片插入进去.Paste'通过图表对象的导出方法，把图片导出到当前目录下.Export ThisWorkbook.Path & \ & wk & _ & k & .png'删除图表.Parent.DeleteEnd WithNextNext'关闭打开的工作簿.Close FalseEnd WithEnd If'继续遍历下一个工作簿wk = DirLoop'开启屏幕刷新Application.ScreenUpdating = TrueEnd Sub图片导出演示

本次案例来自网友提问:需要从600个Excel文件中导出每个文件中的2个图片，之前由于时间原因，回复比较简单没有给出具体实现方法，今天花时间整理写成图文，希望小伙伴们都可以学会。一、 数据模拟为了更加真实的还原提问者遇到的问题，我们需要准备600个且都包含有2个图片的Excel文件。一两个文件我们可以手动新建就可以了，这可是600个文件呐！别担心，既然我们是用VBA来解决问题，解决这种事情重复机械的劳动，当然不是什么难事。图片我们用以下两个代替，放到当前文件目录下，分别命名为test1.png和test2.png，模拟数据时将test1.png插入到第一个表,test2.png插入到第二个工作表。test1.pngtest2.png分步操作过程:第一步:新建一个Excel文件，将它另存为.xlsm格式。启用宏工作簿第二步:打开新建好的.xlsm文件，按快捷键ALT+F11进入VBE界面。进入VBE界面第三步:在VBE工程种插入一个模块。插入模块第四步:在刚刚新建的模块中粘贴以下代码。Sub 生成600个含图片的Excel文件()'关闭刷新，防止屏幕抖动Application.ScreenUpdating = False'定义变量iDim i As Integer'定义i从1循环到600For i = 1 To 600'新增一个工作簿Workbooks.Add'往工作簿的第一个工作表中插入图片test1.pngActiveWorkbook.Sheets(1).Pictures.Insert(ThisWorkbook.Path & \test1.png).Select'往工作簿的第二个工作表中插入图片test2.pngActiveWorkbook.Sheets(2).Pictures.Insert(ThisWorkbook.Path & \test2.png).Select'将工作簿存储到当前路径下ActiveWorkbook.SaveAs ThisWorkbook.Path & \ & i & .xlsx'关闭工作簿ActiveWorkbook.Close'继续循环新建其他工作簿Next'恢复屏幕刷新Application.ScreenUpdating = True'处理完成给出提示MsgBox 600个含图片的Excel文件生成完成！, vbInformation, 提示信息End Sub第五步:执行VBA代码，生成我们需要的600个Excel文件。执行VBA代码连贯操作演示:操作演示二、 图片导出600个案例文件已经准备好了，接下来就是导出文件中的图片。解决思路:1. 一个个的找出当前目录下的所有Excel文件。2. 打开找到的Excel文件。3. 一个个的找出Excel文件中的工作表。4. 找出工作表中的所有图片对象。5. 把找到的每一个图片导出到当前目录下。如果文件不多的情况下，按上面的思路手动操作导出也是可以的，其实通过VBA来解决问题也是要先把复杂问题进行简单化，一步步进行分解问题，最终形成完整解决方案。VBA代码使用方式在上面数据准备过程中已经有详细描述了，本次我们直接来运行下代码，实现导出文件中的图片。Sub 导出当前路径下工作簿中的图片()Dim wk$ '定义为工作簿文件Dim i As Integer '定义工作簿中的工作表数量Dim ii As Integer '定义为工作表中的对象个数'关闭刷新，防止抖动Application.ScreenUpdating = False'遍历第一个工作簿文件wk = Dir(ThisWorkbook.Path & \*.xlsx)'遍历到的文件名不等于空的情况下Do While wk <> '如果文件名称和当前的名称是不一样的。If wk <> ThisWorkbook.Name Then'打开遍历到的工作簿Workbooks.Open (ThisWorkbook.Path & \ & wk)'对打开的工作簿文件进行以下操作With ActiveWorkbook'循环出工作簿中的每一个工作表For i = 1 To .Sheets.Count'循环出工作表中的每一个对象shapeFor ii = 1 To .Sheets(i).Shapes.Count'临时变量，统计shape的个数k = k + 1'复制shape对象.Sheets(i).Shapes(ii).Copy'创建一个图表对象，宽高与与对象保持一致With .Sheets(i).ChartObjects.Add(0, 0, .Sheets(i).Shapes(ii).Width, .Sheets(i).Shapes(ii).Height).Chart'把图片插入进去.Paste'通过图表对象的导出方法，把图片导出到当前目录下.Export ThisWorkbook.Path & \ & wk & _ & k & .png'删除图表.Parent.DeleteEnd WithNextNext'关闭打开的工作簿.Close FalseEnd WithEnd If'继续遍历下一个工作簿wk = DirLoop'开启屏幕刷新Application.ScreenUpdating = TrueEnd Sub图片导出演示