Excel VBA - グラフをGIFファイルとして保存する

Question

プログラミングは私の主な仕事関数ではありませんが、私が考えるスイス軍ナイフのように見えますが、グラフをgifファイルにエクスポートするExcelでVBAマクロを作成する課題があります。当社の製造工場における情報スクリーンの自動更新。

私は動作するマクロを持っていますが、失敗し、正しいファイル名で "空の"グラフを含む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

2つのこと

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のスナップショットやグラフのようなものを取り出し、イメージをエクスポートすると、必要な拡張機能を使用できます。あなたが確認しなければならないのは、ワークシートの一番上までスクロールして、エクスポートしたいすべてのグラフが（あなたに）見えるようにすることだけです。いずれかのグラフが下にある場合は、それを参照してもエクスポートされないため、表示するまで上にドラッグする必要があります。セル（A1）が表示されていることを確認してください。できます！！！