Unregelmäßige Laufzeitfehler in VBA mit dem Kopieren und Einfügen einer Form

1461
Markus

Ich bin neugierig auf 2 VBA-Laufzeitfehler. Das Merkwürdige ist: 9 von 10 mal funktioniert der Code einwandfrei. Von Zeit zu Zeit tritt jedoch 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 feststellen, wann sie erscheinen werden oder nicht.

Das ist was ich mache:

  1. Klicken Sie in Excel auf eine Schaltfläche, die die folgenden Schritte über VBA ausführt
  2. Erstellen Sie ein neues Blatt 'Detailinterview'
  3. Ein Logo aus dem Blatt 'Daten' kopieren
  4. 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 ab und zu ab? Wie kann ich es reparieren?

Danke im Voraus!

Wie hier angefordert, ist 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
0
Sind Sie sicher, dass "detailinreview" existiert? Und dass der Index der gewünschten Form tatsächlich 1 ist? Ich bin mir ziemlich sicher, dass Ihr zweiter Fehler darin besteht, dass das, was Sie wollen, nicht existiert, aber dann prüfen Sie, ob es existiert? Raystafarian vor 8 Jahren 0
Das Blatt existiert definitiv. Es wird in einem anderen Code erstellt. Und ich habe vorher `ThisWorkbook.Worksheets (DETAILINTERVIEW) .Shapes (" MY_LOGO ")` anstelle von `Shapes (1)` verwendet. Es ergab sich jedoch der seltsame Laufzeitfehler. Markus vor 8 Jahren 0
Bitte hinterlassen Sie den Rest Ihres Codes. Kyle vor 8 Jahren 1

1 Antwort auf die Frage

-1
Kyle

Unter Verwendung Select, Activateusw. ist gefährlich. Stattdessen sollten Sie Ihre Objekte explizit bei ihren Eltern qualifizieren. Ex.

Sheets(1).Range("A1").value = 1

Ist besser als

Sheets(1).Activate Range("A1").Select Selection.Value = 1

Ich habe Ihren Code ein wenig 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

Verwandte Probleme