将 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