AW: Mal gehts - mal wieder nicht
06.04.2020 21:57:17
Dennis
Hallo Nepumuk,
super - hab alle umgestellt - und jetzt klappt es toll. Ich danke Dir für Deinen Support! Hoffe ich hab mal Gelegenheit Dir ebenfalls einen Stein in den Garten zu werfen.
Für alle anderen anbei der Code - klappt super.
Sub Outputmodul()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.RefreshAll
Application.CutCopyMode = False
Call DeleteAllPics
'________________
On Error Resume Next
Do
Call Worksheets("D_01").ChartObjects("Diagramm 1-1").CopyPicture(Appearance:=xlScreen, _
Format:=xlPicture)
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
Do
Call Worksheets("Output").Paste(Destination:=Worksheets("Output").Range("E12"))
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
On Error GoTo 0
'________________
On Error Resume Next
Do
Call Worksheets("D_01").ChartObjects("Diagramm 1-2").CopyPicture(Appearance:=xlScreen, _
Format:=xlPicture)
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
Do
Call Worksheets("Output").Paste(Destination:=Worksheets("Output").Range("V12"))
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
On Error GoTo 0
'________________
On Error Resume Next
Do
Call Worksheets("PainPoint_tables").Range("Tabelle10[#All]").CopyPicture
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
Do
Call Worksheets("Output").Paste(Destination:=Worksheets("Output").Range("AM12"))
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
On Error GoTo 0
'________________
On Error Resume Next
Do
Call Worksheets("PainPoint_tables").Range("Tabelle11[#All]").CopyPicture
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
Do
Call Worksheets("Output").Paste(Destination:=Worksheets("Output").Range("BX12"))
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
On Error GoTo 0
'________________________________________________________________________________________
On Error Resume Next
Do
Call Worksheets("D_02").ChartObjects("Diagramm 2-1").CopyPicture(Appearance:=xlScreen, _
Format:=xlPicture)
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
Do
Call Worksheets("Output").Paste(Destination:=Worksheets("Output").Range("E43"))
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
On Error GoTo 0
'________________
On Error Resume Next
Do
Call Worksheets("D_02").ChartObjects("Diagramm 2-2").CopyPicture(Appearance:=xlScreen, _
Format:=xlPicture)
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
Do
Call Worksheets("Output").Paste(Destination:=Worksheets("Output").Range("V43"))
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
On Error GoTo 0
'________________
On Error Resume Next
Do
Call Worksheets("PainPoint_tables").Range("Tabelle20[#All]").CopyPicture
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
Do
Call Worksheets("Output").Paste(Destination:=Worksheets("Output").Range("AM43"))
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
On Error GoTo 0
'________________
On Error Resume Next
Do
Call Worksheets("PainPoint_tables").Range("Tabelle21[#All]").CopyPicture
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
Do
Call Worksheets("Output").Paste(Destination:=Worksheets("Output").Range("BX43"))
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
On Error GoTo 0
'________________________________________________________________________________________
On Error Resume Next
Do
Call Worksheets("D_03").ChartObjects("Diagramm 3-1").CopyPicture(Appearance:=xlScreen, _
Format:=xlPicture)
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
Do
Call Worksheets("Output").Paste(Destination:=Worksheets("Output").Range("E74"))
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
On Error GoTo 0
'________________
On Error Resume Next
Do
Call Worksheets("D_03").ChartObjects("Diagramm 3-2").CopyPicture(Appearance:=xlScreen, _
Format:=xlPicture)
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
Do
Call Worksheets("Output").Paste(Destination:=Worksheets("Output").Range("V74"))
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
On Error GoTo 0
'________________
On Error Resume Next
Do
Call Worksheets("PainPoint_tables").Range("Tabelle30[#All]").CopyPicture
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
Do
Call Worksheets("Output").Paste(Destination:=Worksheets("Output").Range("AM74"))
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
On Error GoTo 0
'________________
On Error Resume Next
Do
Call Worksheets("PainPoint_tables").Range("Tabelle31[#All]").CopyPicture
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
Do
Call Worksheets("Output").Paste(Destination:=Worksheets("Output").Range("BX74"))
If Err.Number = 0 Then Exit Do
Call Err.Clear
DoEvents
Loop
On Error GoTo 0
'________________________________________________________________________________________
Application.CutCopyMode = False
Sheets("Output").Select
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
