Absturz VBA, jedoch nicht beim Durchsteppen
04.12.2018 17:35:09
Michael
Ich möchte nun der Einfachheit halber ein Skript erstellen, dass sequentiell alle 90 Optionen in dieses Feld schreibt und die resultierenden Werte als Screenshot in eine andere Tabelle ablegt.
Dies funktioniert soweit grundsätzlich, allerdings stürzt die Applikation sporadisch ab resp. macht die Aufgabe nicht zu Ende. Der Absturz tritt immer auf aber nicht immer an gleicher Stelle.
Ich habe bereits folgende Workarounds versucht, die Besserung gebracht, das Problem aber nicht gelöst haben:
Hat jemand von Euch eine Ahnung, wo der Bock liegt? Der Absturz ist immer beim Copy-Befehl
Sub AuswertungStarten()
Application.Volatile
Dim stufeAlt As Integer
Dim stufe As Integer
Dim outputZeile As Integer
Dim outputSpalte As Integer
outputZeile = 0 'wird vor erstem ausführen inkrementiert
outputSpalte = 1
stufeAlt = 3
' Grafiken in Auswerte-Blatt löschen
For Each Shape In Worksheets("Auswertung_Detailliert").Shapes
Shape.Delete
Next
' Grafiken generieren und in Auswerte-Blatt kopieren (via Screenshot)
For Each Cell In Worksheets("Beurteilung_Detailliert").Range("AN11:AN91")
If Len(Cell.Value) > 0 Then
'Dropdown auswählen um Grafik zu aktualisieren
Worksheets("Beurteilung_Detailliert").Range("AC13").Value = Cell.Value
'Stufe für Output detektieren
If Len(Worksheets("Beurteilung_Detailliert").Range("AD18").Value) > 0 Then
stufe = 3
ElseIf Len(Worksheets("Beurteilung_Detailliert").Range("AD17").Value) > 0 Then
stufe = 2
Else
stufe = 1
End If
If (stufe > stufeAlt) Then
outputSpalte = outputSpalte + 1
stufeAlt = stufe
ElseIf (stufe = stufeAlt) Then
outputSpalte = outputSpalte + 1
Else
If (stufe = 1) Then
outputSpalte = 1
Else
outputSpalte = 2
End If
outputZeile = outputZeile + 1
stufeAlt = stufe
End If
'Screenshot erstellen
Application.Wait (Now + TimeValue("0:00:01"))
Worksheets("Beurteilung_Detailliert").Range("AB15:AK28").CopyPicture xlScreen, _
xlBitmap
'Screenshot einfügen
Worksheets("Auswertung_Detailliert").Range(Worksheets("Auswertung_Detailliert"). _
Cells(outputZeile, outputSpalte), Worksheets("Auswertung_Detailliert").Cells(outputZeile, _
outputSpalte)).PasteSpecial
End If
Next
End Sub