将 Excel 工作簿中的所有图表导出到 windows 文件夹

Posted

技术标签:

【中文标题】将 Excel 工作簿中的所有图表导出到 windows 文件夹【英文标题】:Export all charts in an Excel-workbook to a windows folder 【发布时间】:2021-09-03 11:03:05 【问题描述】:

我尝试运行以下宏。似乎可以工作(我没有任何错误),但最后只打开一个空文件夹(没有导出图片)。请给我任何建议!我是VBA的初学者。非常感谢!

Sub ExportAllCharts()
    Dim objShell As Object
    Dim objWindowsFolder As Object
    Dim strWindowsFolder As String
    Dim objSheet As Excel.Worksheet
    Dim objChartObject As Excel.ChartObject
    Dim objChart As Excel.Chart

    'Select a Windows folder
    Set objShell = CreateObject("Shell.Application")
    Set objWindowsFolder = objShell.BrowseForFolder(0, "Select a Windows folder:", 0, "")

    If Not objWindowsFolder Is Nothing Then
       strWindowsFolder = objWindowsFolder.self.Path & "\"

       For i = ThisWorkbook.Worksheets.Count To 1 Step -1
           Set objSheet = ThisWorkbook.Worksheets(i)

           If objSheet.ChartObjects.Count > 0 Then
              For Each objChartObject In objSheet.ChartObjects
                  Set objChart = objChartObject.Chart
                  objChart.Export strWindowsFolder & objChart.Name & ".png"
              Next
          End If
       Next

       'Open the windows folder
       Shell "Explorer.exe" & " " & strWindowsFolder, vbNormalFocus
   End If
End Sub

Source code link

现在我正在尝试找到一种解决方案来导出所有具有工作表名称+后缀的图表。 我希望我可以在弹出窗口中插入所需的后缀(所有工作表都相同)。

我有这段代码重命名所有工作表,但我需要修改它以仅重命名它们部分。我想也许我可以将它合并到初始宏中。

Sub ChangeWorkSheetName()
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "Write the new Worksheets Name"
NewName = Application.InputBox("Name", xTitleId, "", Type:=2)
j = 1
For i = 1 To Application.Sheets.Count
If Application.Sheets(i).Visible Then
Application.Sheets(i).Name = NewName & j
j = j + 1
End If
Next
End Sub

谁能给我一个建议?非常感谢!

【问题讨论】:

为我工作。您的图表是在图表上,还是嵌入在工作表中?这只会导出第二种图表。 您确定您的工作簿包含任何图表...?请在Set objSheet = ThisWorkbook.Worksheets(i) 之后插入下一个代码行:Debug.Print objSheet.ChartObjects.Count。它是否在立即窗口中返回任何大于 0 的数字? 【参考方案1】:

如果您需要在图表表中包含图表,则需要第二个循环:

Sub ExportAllCharts()
    Dim objShell As Object
    Dim objWindowsFolder As Object
    Dim strWindowsFolder As String
    Dim objSheet As Excel.Worksheet
    Dim objChartObject As Excel.ChartObject
    Dim objChart As Excel.Chart
    
    'Select a Windows folder
    Set objShell = CreateObject("Shell.Application")
    Set objWindowsFolder = objShell.BrowseForFolder(0, "Select a Windows folder:", 0, "")
    
    If Not objWindowsFolder Is Nothing Then
        strWindowsFolder = objWindowsFolder.self.Path & "\"
        
        'charts on chart sheets
        For Each objChart In ThisWorkbook.Charts
            objChart.Export strWindowsFolder & objChart.Name & ".png"
        Next objChart
        
        'chartobjects (on worksheets)
        For Each objSheet In ThisWorkbook.Worksheets
            For Each objChartObject In objSheet.ChartObjects
                With objChartObject.Chart
                    .Export strWindowsFolder & .Name & ".png"
                End With
            Next
        Next
        
        'Open the windows folder
        Shell "Explorer.exe" & " " & strWindowsFolder, vbNormalFocus
    End If
End Sub

【讨论】:

您好!这么晚才回复很抱歉。我的图表在图表表上。在第二个循环中效果很好,非常感谢蒂姆!你用你的答案救了我! :)

以上是关于将 Excel 工作簿中的所有图表导出到 windows 文件夹的主要内容,如果未能解决你的问题,请参考以下文章

使用 Python 将图表从 Excel 转换为 PowerPoint

如何将 Access 数据库中的所有表导出到 Excel - 每个表的工作表

Excel EXCEL中怎样用VBA来写图表

将同一工作簿中的多个 Excel 工作表复合到一张工作表中

使用 VBA 遍历工作簿中的所有图表

将 Excel 工作簿中的所有工作表转换为 csv 格式