Excel VBA - 將圖表保存爲GIF文件

Question

編程不是我的主要工作功能，但似乎是我認爲的瑞士軍刀，我一直負責在Excel中製作VBA宏，以便將圖形導出爲gif文件我們製造工廠的信息屏幕自動更新。

我有一個宏的工作，但是，它有時會失敗，並創建一個與正確的文件名，但「空」圖形的GIF。

用戶在工作表的範圍內定義自己的導出路徑以及導出圖表的尺寸。

Sub ExportAllCharts() 
    Application.ScreenUpdating = False 
    Const sSlash$ = "\" 
    Const sPicType$ = "gif" 
    Dim sChartName As String 
    Dim sPath As String 
    Dim sExportFile As String 
    Dim ws As Worksheet 
    Dim wb As Workbook 
    Dim chrt As ChartObject 
    Dim StdXAxis As Double 
    Dim StdYAxis As Double 
    Dim ActXAxis As Double 
    Dim ActYAxis As Double 
    Dim SheetShowPct As Double 

    Set wb = ActiveWorkbook 
    Set ws = ActiveSheet 

    StdXAxis = Range("StdXAxis").Value 
    StdYAxis = Range("StdYAxis").Value 

    sPath = Range("ExportPath").Value 
    If sPath = "" Then sPath = ActiveWorkbook.Path 

    For Each ws In wb.Worksheets 'check all worksheets in the workbook 
     If ws.Name = "Graphs for Export" Then 
      SheetShowPct = ws.Application.ActiveWindow.Zoom 
      For Each chrt In ws.ChartObjects 'check all charts in the current worksheet 
       ActXAxis = chrt.Width 
       ActYAxis = chrt.Height 
       With chrt 
        If StdXAxis > 0 Then .Width = StdXAxis 
        If StdYAxis > 0 Then .Height = StdYAxis 
       End With 
       sChartName = chrt.Name 
       sExportFile = sPath & sSlash & sChartName & "." & sPicType 
       On Error GoTo SaveError: 
        chrt.Chart.Export Filename:=sExportFile, FilterName:=sPicType 
       On Error GoTo 0 
       With chrt 
        .Width = ActXAxis 
        .Height = ActYAxis 
       End With 
      Next chrt 
      ws.Application.ActiveWindow.Zoom = SheetShowPct 
     End If 
    Next ws 
    Application.ScreenUpdating = True 

MsgBox ("Export Complete") 
GoTo EndSub: 

SaveError: 
MsgBox ("Check access rights for saving at this location: " & sPath & Chr(10) & Chr(13) & "Macro Terminating") 

EndSub: 

End Sub 

得到的幫助後，這是宏代碼我最後決定將在工作簿： 感謝您的幫助。

Const sPicType$ = "gif" 
Sub ExportAllCharts() 

Application.ScreenUpdating = False 
Dim sChartName As String, sPath As String, sExportFile As String 
Dim ws As Worksheet 
Dim wb As Workbook 
Dim chrt As ChartObject 
Dim StdXAxis As Double, StdYAxis As Double, ActXAxis As Double 
Dim ActYAxis As Double, SheetShowPct As Double 

Set wb = ActiveWorkbook 
StdXAxis = Range("StdXAxis").Value 
StdYAxis = Range("StdYAxis").Value 
sPath = Range("ExportPath").Value 
If sPath = "" Then sPath = ActiveWorkbook.Path 

Set ws = wb.Sheets("Graphs for Export") 

For Each chrt In ws.ChartObjects 
    With chrt 
     ActXAxis = .Width 
     ActYAxis = .Height 
     If StdXAxis > 0 Then .Width = StdXAxis 
     If StdYAxis > 0 Then .Height = StdYAxis 
     sExportFile = sPath & "\" & .Name & "." & sPicType 
     .Select 
     .Chart.Export Filename:=sExportFile, FilterName:=sPicType 
     .Width = ActXAxis 
     .Height = ActYAxis 
    End With 
Next chrt 

Application.ScreenUpdating = True 
MsgBox ("Export Complete") 

End Sub 

Answer 1

兩件事情

1）刪除 「上的錯誤繼續下一步」。如果路徑是否正確，你還會怎麼知道？

2）不是循環遍歷形狀，而是循環遍歷圖表對象？例如

Dim chrt As ChartObject 

For Each chrt In Sheet1.ChartObjects 
    Debug.Print chrt.Name 
    chrt.Chart.Export Filename:=sExportFile, FilterName:=sPicType 
Next 

隨訪

試試這個。

Const sPicType$ = "gif" 

Sub ExportAllCharts() 
    Application.ScreenUpdating = False 

    Dim sChartName As String, sPath As String, sExportFile As String 
    Dim ws As Worksheet 
    Dim wb As Workbook 
    Dim chrt As ChartObject 
    Dim StdXAxis As Double, StdYAxis As Double, ActXAxis As Double 
    Dim ActYAxis As Double, SheetShowPct As Double 

    Set wb = ActiveWorkbook 

    StdXAxis = Range("StdXAxis").Value 
    StdYAxis = Range("StdYAxis").Value 

    sPath = Range("ExportPath").Value 
    If sPath = "" Then sPath = ActiveWorkbook.Path 

    Set ws = wb.Sheets("Graphs for Export") 
    For Each chrt In ws.ChartObjects 
     ActXAxis = chrt.Width 
     ActYAxis = chrt.Height 
     With chrt 
      If StdXAxis > 0 Then .Width = StdXAxis 
      If StdYAxis > 0 Then .Height = StdYAxis 

      sChartName = .Name 
      sExportFile = sPath & "\" & sChartName & "." & sPicType 
      .Select 
      .Chart.Export Filename:=sExportFile, FilterName:=sPicType 
      .Width = ActXAxis 
      .Height = ActYAxis 
     End With 
    Next chrt 

    MsgBox ("Export Complete") 

    Exit Sub 
SaveError: 
    MsgBox ("Check access rights for saving at this location: " & sPath & _ 
    Chr(10) & Chr(13) & "Macro Terminating") 
End Sub 

Answer 2

我只是想出了零圖思想的問題。我聽說有人說Excel中有一個錯誤，但實際上並沒有。不知何故，excel需要一個快照或類似於圖形的東西，然後導出圖像，你可以使用任何你想要的擴展名。所有你必須確定的是你直接滾動到工作表的頂部，並確保你想要導出的所有圖形都是可分離的（對你而言）。如果有任何圖表在下面，那麼即使您參考它也不會導出，因此您需要將它一直拖到頂部直到您看到它。只要確保你看到細胞（A1）。有用！！！