我对 2 个 VBA 运行时错误感到好奇。奇怪的是:10 次中有 9 次代码运行正常。但有时会出现以下 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
答案1
使用Select
等Activate
很危险。您应该使用对象的父对象明确限定对象。例如
Sheets(1).Range("A1").value = 1
优于
Sheets(1).Activate
Range("A1").Select
Selection.Value = 1
我稍微整理了一下你的代码:
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