
Mich interessieren 2 VBA-Laufzeitfehler. Das Merkwürdige dabei ist: 9 von 10 Mal funktioniert der Code einwandfrei. Aber von Zeit zu Zeit tritt einer der 2 folgenden Laufzeitfehler auf:
Run-Time error '1004': Paste method of Picture object failed
Run-time error -214724809 (80070057): The index into the specified collection is out of bounds.
Ich konnte keine Abhängigkeiten erkennen, wann es erscheinen wird oder nicht.
Das ist was ich mache:
- Klicken Sie auf eine Schaltfläche in Excel, die die folgenden Schritte über VBA ausführt
- Erstellen Sie ein neues Blatt „Detailinterview“
- Ein Logo aus dem Datenblatt kopieren
- Fügen Sie es in das Blatt „Detailinterview“ ein.
Das ist mein Code
Public Const DATA = "Data"
Public Const DETAILINTERVIEW = "Detailinterview"
Public Sub DoMagic()
Dim logo As Shape
'Some other code
For Each logo In Sheets(DATA).Shapes
If logo.Name = "MY_LOGO" Then
logo.Copy
Sheets(DETAILINTERVIEW).Pictures.Paste ' runtime error 1004
End If
Next
' Hint: Sheet DETAILINTERVIEW contains only 1 shape: MY_LOGO
Set logo = Worksheets(DETAILINTERVIEW).Shapes(1) 'runtime error -214724809
If Not logo Is Nothing Then
logo.IncrementLeft 580
logo.IncrementTop 4
End If
End Sub
Warum stürzt VBA ab? Warum stürzt es nur von Zeit zu Zeit ab? Wie kann ich das Problem beheben?
Dank im Voraus!
Wie gewünscht ist hier der Rest des Codes:
Public Const DATA = "Data"
Public Const DETAILINTERVIEW = "Detailinterview"
Public Sub DoMagic()
Dim logo As Shape
Dim i As Long
Dim sheetExists As Boolean
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
For i = 1 To Sheets.Count
If Sheets(i).Name = DETAILINTERVIEW Then
sheetExists = True
Debug.Print MsgBox("A worksheet 'Detailinterview' exists already!", vbOKOnly)
Exit Sub
End If
Next i
Worksheets("Datenblatt_Template").Copy after:=Worksheets(QUESTION_SELECTION)
Worksheets("Datenblatt_Template (2)").Visible = True
Worksheets("Datenblatt_Template (2)").Activate
ActiveSheet.Name = DETAILINTERVIEW
Worksheets(DETAILINTERVIEW).Columns("I:I").ColumnWidth = 1
Worksheets(DETAILINTERVIEW).Columns("K:K").ColumnWidth = 33
Worksheets(DETAILINTERVIEW).Columns("M:M").ColumnWidth = 17
Worksheets(DETAILINTERVIEW).Columns("O:O").ColumnWidth = 3
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
ThisWorkbook.Worksheets(DETAILINTERVIEW).Range("A:H").EntireColumn.Hidden = True
ThisWorkbook.Worksheets("Templates").Range("T_HEADER").Copy
ThisWorkbook.Worksheets(DETAILINTERVIEW).Activate
ThisWorkbook.Worksheets(DETAILINTERVIEW).Rows("1:1").Select
ThisWorkbook.ActiveSheet.Paste
ThisWorkbook.Worksheets("Templates").Range("T_MASTER_HEADER").Copy
ThisWorkbook.Worksheets(DETAILINTERVIEW).Activate
ThisWorkbook.Worksheets(DETAILINTERVIEW).Rows("2:2").Select
ThisWorkbook.ActiveSheet.Paste
Worksheets(DETAILINTERVIEW).Range("J2").Value = Range(START & "!C20") & " - " & Range(START & "!C21") & " - " & Range(START & "!C22")
For Each logo In Sheets(DATA).Shapes
If logo.Name = "MY_LOGO" Then
logo.Copy
Sheets(DETAILINTERVIEW).Pictures.Paste ' runtime error 1004
End If
Next
' Hint: Sheet DETAILINTERVIEW contains only 1 shape: MY_LOGO
Set logo = Worksheets(DETAILINTERVIEW).Shapes(1) 'runtime error -214724809
If Not logo Is Nothing Then
logo.IncrementLeft 580
logo.IncrementTop 4
End If
' Some more Magic
End Sub
Antwort1
Die Verwendung Select
von Activate
usw. ist gefährlich. Sie sollten Ihre Objekte stattdessen explizit mit ihren Eltern qualifizieren. Beispiel:
Sheets(1).Range("A1").value = 1
Ist besser als
Sheets(1).Activate
Range("A1").Select
Selection.Value = 1
Ich habe deinen Code etwas aufgeräumt:
Option Explicit
Public Const DATA = "Data"
Public Const DETAILINTERVIEW = "Detailinterview"
Public Sub DoMagic()
Dim logo As Shape
Dim i As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
For i = 1 To Sheets.Count
If Sheets(i).Name = DETAILINTERVIEW Then
Debug.Print MsgBox("A worksheet " & DETAILINTERVIEW & " exists already!", vbOKOnly)
Exit Sub
End If
Next i
Dim ws As Worksheet
With ThisWorkbook
.Worksheets("Datenblatt_Template").Copy after:=.Worksheets(.Worksheets.Count)
Set ws = .Worksheets(.Worksheets.Count)
End With
With ws
.Name = DETAILINTERVIEW
.Columns("I:I").ColumnWidth = 1
.Columns("K:K").ColumnWidth = 33
.Columns("M:M").ColumnWidth = 17
.Columns("O:O").ColumnWidth = 3
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
.Range("A:H").EntireColumn.Hidden = True
ThisWorkbook.Worksheets("Templates").Range("T_HEADER").Copy Destination:=.Range("A1")
ThisWorkbook.Worksheets("Templates").Range("T_MASTER_HEADER").Copy Destination:=.Range("A2")
'***************************
'I can't get the next line to run because Start is uninitialized
'.Range("J2").Value = Range(Start & "!C20") & " - " & Range(Start & "!C21") & " - " & Range(Start & "!C22")
'****************************
For Each logo In Sheets(DATA).Shapes
If logo.Name = "MY_LOGO" Then
logo.Copy
.Pictures.Paste
.Shapes(1).IncrementLeft 580
.Shapes(1).IncrementTop 4
Exit For
End If
Next
If .Shapes.Count < 1 Then Debug.Print "Logo not found"
End With
' Some more Magic
End Sub