Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

工作中常用的Excel函数公式,全印在一张超大鼠标垫上
查看: 602|回复: 9

[已解决] excel多个工作表中折线图批量导出该怎么设置?

[复制链接]
发表于 2019-12-5 09:14 | 显示全部楼层 |阅读模式
我有很多个excel文件,文件中有很多工作表,最多的有30个 工作中需要把每个工作表中自动生成的两张折线图按照折线图的标题名称另存为图片,一张一张另存太麻烦了 想请教各位大神有没有更快捷的方法能批量自动按照标题名称把折线图导出来,谢谢大家

温湿度比对.zip

85.61 KB, 下载次数: 3

发表于 2019-12-5 10:02 | 显示全部楼层
Sub test()
    Dim p, f
    Application.ScreenUpdating = False
    p = ThisWorkbook.Path & "\"
     If Dir(p & "Pic", vbDirectory) = "" Then MkDir p & "Pic"
    f = Dir(p & "Data\")
    Do While f <> ""
        Call test2(p, f)
        f = Dir
    Loop
End Sub


'某个工作簿
Sub test2(p, f)
    Dim wb, sh, c, str
    Set wb = Workbooks.Open(p & "Data\" & f)
    For Each sh In wb.Sheets
        For Each c In sh.ChartObjects
            str = Split(wb.Name, ".")(0) & "_" & sh.Name & "日_" & c.Index
            str = VBA.Replace(str, "-", "月")
            Call test3(c, p & "Pic\" & str & ".jpg")
        Next c
    Next sh
    wb.Close False
End Sub


'某个图表(对象, 路径)
Sub test3(obj, f)
    obj.CopyPicture Appearance:=xlScreen, Format:=xlBitmap                '将所选对象作为图片复制到剪贴板
    With ActiveSheet.ChartObjects.Add(0, 0, obj.Width, obj.Height).Chart   '创建嵌入式图表
        .Paste                                                          '将剪贴板中的图表数据粘贴到指定的图表中
        .Export Filename:=f                                             '以图形格式导出图表
        .Parent.Delete
    End With
End Sub

1.rar (584.64 KB, 下载次数: 4)
回复

使用道具 举报

 楼主| 发表于 2019-12-5 10:27 | 显示全部楼层
爱疯 发表于 2019-12-5 10:02
Sub test()
    Dim p, f
    Application.ScreenUpdating = False

大神 我大概摸索出了你做的这个宏的用法 万分感谢 不过生成的图片文件名称与折线图的标题名称不一致 这个能不能再优化一下
回复

使用道具 举报

发表于 2019-12-5 10:55 | 显示全部楼层
lq50504 发表于 2019-12-5 10:27
大神 我大概摸索出了你做的这个宏的用法 万分感谢 不过生成的图片文件名称与折线图的标题名称不一致 这个 ...

不知道图片文件名有怎样的要求,可以具体举个例子吗?

回复

使用道具 举报

 楼主| 发表于 2019-12-5 11:19 | 显示全部楼层
导出来的图片你打开看下 上面有标题 每个图片都不一样 例如 03-05温度比对 01-05湿度比对 这种名称
回复

使用道具 举报

发表于 2019-12-5 11:39 | 显示全部楼层
QQ截图20191205112956.png


图片文件名 = excel文件名 + (转为日期的)工作表名 + 图片索引号

楼主可按自己的需求,改下 变量 str

回复

使用道具 举报

 楼主| 发表于 2019-12-5 11:46 | 显示全部楼层
我尝试一下 谢谢大神指导思路
回复

使用道具 举报

发表于 2019-12-5 17:17 | 显示全部楼层
2.rar (188.73 KB, 下载次数: 7)
回复

使用道具 举报

 楼主| 发表于 2019-12-6 10:48 | 显示全部楼层
膜拜中 太强了
回复

使用道具 举报

发表于 2020-3-1 13:18 | 显示全部楼层
我也遇到这个问题啊,可以请教大师们吗?
回复

使用道具 举报

*滑块验证:
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2020-8-4 19:05 , Processed in 0.078000 second(s), 6 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表