Мне любопытно 2 ошибки VBA во время выполнения. Любопытно, что 9 из 10 раз код работает отлично. Но время от времени появляется одна из 2 следующих ошибок времени выполнения:
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.
Я не мог определить какие-либо зависимости, когда он появится или не появится.
Вот что я делаю:
- Нажмите на кнопку в Excel, которая выполнит следующие шаги через VBA
- Создайте новый лист 'Detailinterview'
- Скопируйте логотип с листа «данные»
- Вставьте его на лист "Detailinterview"
Это мой код
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
Почему происходит сбой VBA? Почему время от времени происходит сбой? Как я могу это исправить?
Заранее спасибо!
В соответствии с запросом здесь остальная часть кода:
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