Excel交流网
  • 设为首页|收藏本站|手机版
  • Excel-教程-技巧-培训视频

  • 网站首页
  • Excel教程
  • 关于我们
  • 新闻动态
  • Excel资源
  • 招贤纳士

Excel教程

Excel操作
Excel函数
Excel图表
Excel VBA
Excel 行业应用

联系方式

Excel中国 联系方式
电  话:400-855-3990
邮  编:528400
Email:support@zstm.com
网  址:www.excel-cn.com

当前位置:网站首页 > Excel教程 > Excel VBA
Excel VBA

导出文件夹内多个Excel文件的图片

前面我们讲过怎么导出Excel工作表中的图片。

那么如何将一个文件夹内的全部Excel中的sheet1工作表的图片导出。

如果sheet1 有多张图片,即命名为“Excel表名(1),Excel表名(2)”这样循环


效果动态图:

保存图片.gif


详细VBA源码:

Sub 保存图片()

    Dim MyPath$, myFolder$, myName$

    Dim wb As Workbook, Sh As Worksheet, shp As Shape, m%, n%

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

    MyPath = ThisWorkbook.Path

    myFolder = MyPath & "\图片\"

    If Len(Dir(myFolder, vbDirectory)) = 0 Then MkDir myFolder

    myName = Dir(MyPath & "\*.xls", vbDirectory)

    Do While myName <> ""

        If myName <> ThisWorkbook.Name Then

            n = 0

            Set wb = Workbooks.Open(MyPath & "\" & myName) 'Filename:=MyPath & "\" & myName '& ".xls" ', Password:=""

            For Each Sh In wb.Sheets

                For Each shp In Sh.Shapes

                    n = n + 1

                    shp.CopyPicture

                    With Sh.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart

                        .Paste

                        .Export myFolder & myName & "(" & n & ").JPG", "JPG"

                        .Parent.Delete

                    End With

                Next

            Next

            wb.Close savechanges:=False

        End If

        m = m + n

        myName = Dir

    Loop

    MsgBox "保存了 " & m & "张图片"

    Application.DisplayAlerts = True

    Application.ScreenUpdating = True

End Sub


参考至:一指禅62(excelhome)



点击次数:  更新时间:2017-09-06 15:38:34  【打印此页】  【关闭】
上一条:Excel VBA数据验证与正则表达式汇总整理  下一条:Excel VBA数据访问方式汇总整理
本站动态|在线留言|在线反馈|友情链接|会员中心|站内搜索|网站地图|网站管理

中山市天鸣科技发展有限公司 版权所有 1999-2020 粤ICP备10043721号

广东省中山市西苑广场富贵阁 528400

QQ:4008553990 电话:0760-88315075

Excel交流网主要交流Excel教程、Excel技巧、Excel培训、Excel函数公式、Excel图表以及Excel VBA,为网友提供一个最全的Excel交流网站

Excel教程|Excel技巧|Excel培训|Excel函数公式|Excel图表|VBA

Powered by MetInfo 5.3.12 ©2008-2022  www.metinfo.cn