2012-02-28 2 views
3

프로그래밍 내 주요 일 함수가 아닌 GIF 파일로 차트를 저장,하지만 난 그래프가 파일을 GIF로 수출 Excel에서 VBA 매크로를 만들기에, 나는 임무를 한 것으로 간주하고있는 스위스 군용 나이프로 나타나는 우리 공장의 정보 스크린 자동 업데이트.엑셀 VBA는 -

나는하지만, 때로는 실패, 작동 및 올바른 파일 이름하지만 "빈"그래프와 지프를 생성하는 매크로를 가지고있다.

사용자는 내 보낸 차트의 크기뿐만 아니라 워크 시트의 범위에서 고유 한 내보내기 경로를 정의합니다. 감사를 도움 :

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 

답변

4

두 가지

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 
+0

좋은 지적 정보에 대한 – JMax

+0

감사 (+1 오류 처리에 대한 알림에 대한 최소한), 나는 새로운 코드로 내 질문을 편집했습니다. 그러나 여전히 그래프의 일부를 무작위로 0 바이트 크기의 빈 빈 GIF로 내 보냅니다. –

+0

@Rasmus Nielsen : 빈 차트가없는 것은 확실합니까? 더 빠른 해상도를 위해 Excel 파일 복사본을 볼 수 있습니까? 그렇다면 wikisend.com에서 파일을 업로드하고 여기에 링크를 공유 할 수 있습니다. –

1

제로 그래프의 문제를 생각해 냈습니다. 사람들이 Excel에 버그가 있다고하지만 실제로는 버그가 없다고 들었습니다. 어떻게 든 Excel의 스냅 샷이나 그래프와 같은 것을 가져온 다음 이미지를 내 보내면 원하는 확장자를 사용할 수 있습니다. 확인해야 할 것은 워크 시트의 맨 위로 스크롤하고 내보내려는 모든 그래프를 볼 수 있어야한다는 것입니다. 그래프가 아래에 있으면 참조하는 경우에도 내보낼 수 없으므로 그래프를 볼 수있을 때까지 위로 끌 필요가 있습니다. 세포 (A1)가 보이는지 확인하십시오. 그것은 작동합니다!