|
Hallo,
Folgendes Programm funktioniert und wird auch erfolgreich beendet. Möchte man jedoch Excel schließen kommt die Fehlermeldung:
"Microsoft Excel funktioniert nicht mehr."
Das Programm speichert einen Ausschnitt aus einem Tabellenblatt und speichert dieses als .jpg ab.
Der Fehler wird durch die hervorgehobene Zeile verursacht: (ws.Delete)
Ich denke es liegt an einer falschen Deklaration oder daran. dass das Tabellenblatt noch verwendet wird.
Kann mir jmd helfen?
P.S. Die "DoEvents" sind aus der Fehlersuche heraus entstanden.
Public Sub SaveRangeScreenshot(ByVal rng As Excel.Range)
Dim objChart As ChartObject
Dim BlattName As String
Dim ws As Excel.Worksheet
Dim pic As Picture
Dim sDatei As String
Dim sZielDatei As String
Dim sPfad As String
Dim strFilename As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.DisplayAlerts = False
sPfad = ActiveWorkbook.Path & "\"
sDatei = Worksheets("Tabelle1").Cells(2, 6).Value
sZielDatei = sPfad & sDatei _
& "_" & Format(Date, "yyyy_MM_dd_") _
& Format(Time, "hh-nn-ss")
strFilename = sZielDatei & ".jpg"
rng.Copy
DoEvents
Set ws = ThisWorkbook.Worksheets.Add
DoEvents
Set pic = ws.Pictures.Paste(Link:=True)
DoEvents
pic.CopyPicture Appearance:=xlScreen, Format:=xlPicture
DoEvents
Set objChart = ws.ChartObjects.Add(0, 0, pic.Width, pic.Height)
DoEvents
With objChart.Chart
DoEvents
.Paste
DoEvents
.Export strFilename
DoEvents
End With
DoEvents
ErrExit:
On Error Resume Next
DoEvents
ws.Delete
DoEvents
Set ws = Nothing
Set pic = Nothing
Set objChart = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description, vbCritical, "Fehler " & Err.Number & " aufgetreten!"
Resume ErrExit
End Sub
Private Sub CommandButton1_Click()
Call SaveRangeScreenshot(Range("A2:D10"))
End Sub
|