excel vba数据一键导出(非常有用的VBA代码)

本次案例来自悟空问答网友提问,之前由于时间原因,回复比较简单没有给出具体实现方法,今天花时间整理写成图文,希望小伙伴们都可以学会。@沉默的生物钟


excel vba数据一键导出(非常有用的VBA代码)(1)

实际问题

一、数据模拟--素材准备

为了更加真实的还原提问者遇到的问题,我们需要准备600个且都包含有2个图片的Excel文件。


excel vba数据一键导出(非常有用的VBA代码)(2)

一两个文件我们可以手动新建就可以了,这可是600个文件呐!别担心,既然我们是用VBA来解决问题,解决这种事情重复机械的劳动,当然不是什么难事。图片我们用以下两个代替,放到当前文件目录下,分别命名为test1.png和test2.png,模拟数据时将test1.png插入到第一个表,test2.png插入到第二个工作表。


excel vba数据一键导出(非常有用的VBA代码)(3)

test1.png


excel vba数据一键导出(非常有用的VBA代码)(4)

test2.png




二、数据模拟--分步操作过程


第一步:新建一个Excel文件,将它另存为.xlsm格式。


excel vba数据一键导出(非常有用的VBA代码)(5)

启用宏的工作簿


第二步:打开新建好的.xlsm文件,按快捷键ALT F11进入VBE界面。


excel vba数据一键导出(非常有用的VBA代码)(6)

进入VBE界面


第三步:在VBE工程中插入一个模块。


excel vba数据一键导出(非常有用的VBA代码)(7)

插入模块


第四步:在刚刚新建的模块中粘贴以下代码。


Sub 生成600个含图片的Excel文件() '关闭刷新,防止屏幕抖动 Application.ScreenUpdating = False '定义变量i Dim i As Integer '定义i从1循环到600 For i = 1 To 600 '新增一个工作簿 Workbooks.Add '往工作簿的第一个工作表中插入图片test1.png ActiveWorkbook.Sheets(1).Pictures.Insert(ThisWorkbook.Path & "\test1.png").Select '往工作簿的第二个工作表中插入图片test2.png ActiveWorkbook.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文件


excel vba数据一键导出(非常有用的VBA代码)(8)

执行VBA代码




三、数据模拟--连贯操作演示:


excel vba数据一键导出(非常有用的VBA代码)(9)

演示效果


四、图片导出--解决思路

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 '循环出工作表中的每一个对象shape For 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.Delete End With Next Next '关闭打开的工作簿 .Close False End With End If '继续遍历下一个工作簿 wk = Dir Loop '开启屏幕刷新 Application.ScreenUpdating = True MsgBox "600个含图片的Excel文件图片导出完成!", vbInformation, "提示信息" End Sub


五、图片导出--操作演示


excel vba数据一键导出(非常有用的VBA代码)(10)

演示效果



小伙伴们,如果VBA代码有做注释说明,如有任何问题欢迎,评论区讨论,谢谢!

,

免责声明:本文仅代表文章作者的个人观点,与本站无关。其原创性、真实性以及文中陈述文字和内容未经本站证实,对本文以及其中全部或者部分内容文字的真实性、完整性和原创性本站不作任何保证或承诺,请读者仅作参考,并自行核实相关内容。文章投诉邮箱:anhduc.ph@yahoo.com

    分享
    投诉
    首页