ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1327|回复: 0

用同一个宏处理文件夹下多个电子表生成图表,能操作但会生成同样的两张图表,求救!

[复制链接]

TA的精华主题

TA的得分主题

发表于 2016-10-26 21:17 | 显示全部楼层 |阅读模式
本帖最后由 jsczxie 于 2016-10-26 21:18 编辑

正好单位要对多个电子表进行生成图表设置,同样的操作觉得比较麻烦就搜了一下,找到这个代码想直接套用。但是有一个问题就是运行后会生成两张图表,不知道有高手能说明一下吗?
我用红色标出来的是我将这两句去除了,直接用。

下面是我的代码
-------------------------------------------------------------------------------------------
Sub 多个文件应用宏()
'
' 选择一个目录对每个文件应用宏
    Dim Path$, File$
    Dim Wb As Workbook, sht As Worksheet
    Application.DisplayAlerts = False
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            Path = .SelectedItems(1)
            File = Dir(Path & "\*.xls")
            Application.EnableEvents = False
            Application.Calculation = xlCalculationManual
            Do Until LenB(File) = 0
                Set Wb = Workbooks.Open(Filename:=Path & "\" & File)
                '打开路径下的文件
                For Each sht In Wb.Worksheets

       '下面学生表一改成自己的表名
                   'If sht.Name = "学生表一" Then


                        'TO DO SOMETHING,这里填写每个Excel工作薄文件要操作的宏,不会写可以录制一个宏,然后把录制的

宏的代码填在这里,具体可以看后面
'
' 宏1 宏
'

'
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlBarStacked
    ActiveChart.SetSourceData Source:=Range("Sheet1!$D:$D,Sheet1!$H:$H")
    ActiveSheet.Shapes("图表 1").IncrementLeft 311.25
    ActiveSheet.Shapes("图表 1").IncrementTop -82.5

                    'End If
                  Next
                Wb.SaveAs Filename:=Path & "\" & File
                '保存替换原文件

                   Wb.Close True
                   '关闭文件

                File = Dir
            Loop
            Application.DisplayAlerts = True
            '关闭提示,与前面的FALSE对应
            Application.EnableEvents = True
            Application.Calculation = xlCalculationAutomatic
        End If
    End With
End Sub
-------------------------------------------------------------------------------------------


2.png
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-26 10:44 , Processed in 0.043353 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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