Question

所以我在这个网站上发现了一个用于复制按钮的宏，我已经实现了它但是我遇到了问题，每次运行宏都会失败。我的数据（目前）在F3：N27中。当我运行此代码时，它应该找到包含数据的最后一行并粘贴下一行的按钮。

我有4个选项按钮（optCopy1，optCopy2，optCopy3，optCopy4）和一个不在屏幕上的Group Box（boxCopy）。这是我在网站上找到的代码，修改为添加“btnNewName”变量：

Private Sub CopyButton(from As String, btnName As String, toWorksheet As String, rng As String, btnNewName As String)
Sheets(from).Shapes(btnName).Copy
Sheets(toWorksheet).Activate
Sheets(toWorksheet).Range(rng).Select
Sheets(toWorksheet).Paste
Selection.ShapeRange.Name = btnNewName
End Sub

以上代码的修改版本用于复制组框：

Private Sub CopyBox(from As String, boxName As String, toWorksheet As String, rng As String, boxNewName As String)
Sheets(from).Shapes(boxName).Copy
Sheets(toWorksheet).Activate
Sheets(toWorksheet).Range(rng).Select
Sheets(toWorksheet).Paste
Selection.ShapeRange.Name = boxNewName
End Sub

这是我正在运行的主要子项目：

Sub btnButtonCopy()
Dim fRow As Integer
Dim lRow As Integer

With Worksheets("Sheet1")
.Select
.Range("Numbers").Select
lRow = ActiveCell.Row
fRow = .Range("Numbers").Row + 1
End With

Application.ScreenUpdating = False
CopyButton "Sheet1", "optCopy1", "Sheet1", "G" & lRow + 1, "btnR" & lRow + 1 & "P"
CopyButton "Sheet1", "optCopy2", "Sheet1", "I" & lRow + 1, "btnR" & lRow + 1 & "S"
CopyButton "Sheet1", "optCopy3", "Sheet1", "K" & lRow + 1, "btnR" & lRow + 1 & "A"
CopyButton "Sheet1", "optCopy4", "Sheet1", "M" & lRow + 1, "btnR" & lRow + 1 & "O"

CopyBox "Sheet1", "boxCopy", "Sheet1", "G" & lRow + 1, "boxR" & lRow + 1
Application.ScreenUpdating = False

With Worksheets("Sheet1")
With .Range(.Cells(fRow, 6), .Cells(lRow + 1, 14))
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
End With

With Worksheets("Sheet1")
.Range("Numbers").Select
End With

ActiveSheet.Shapes.Range(Array("btnR" & lRow + 1 & "P")).Select
With Selection
.LinkedCell = "$O$" & lRow + 1
End With

With Worksheets("Sheet1")
.Range("Numbers").Select
End With
End Sub

所以，在我在这个网站上找到的CopyButton的原始代码中，“Application.ScreenUpdating行实际上在那个子集中（第一行之前为False，最后一行之后为True）。当我这样做时，它会在第二次运行代码时失败，即一旦它在我的btnButtonCopy宏中到达这一行：

CopyButton "Sheet1", "optCopy2", "Sheet1", "I" & lRow + 1, "btnR" & lRow + 1 & "S"

它将转到CopyButton子（如预期的那样）并失败。由于我已经将ScreenUpdating行移动到我的btnButtonCopy子，因此它更加一致，但它仍然可能失败，可能是3次中的1次。当它现在失败时，当失败时它就不一致了。有时它是在第二次运行CopyButton，有时是第三次运行，有时是第四次运行，但它在第一次运行时永远不会失败，并且它在CopyBox运行时永远不会失败。

所以现在，我只是尝试运行它5次并且每次在第三次运行CopyButton时失败（我可以告诉它是第三次运行因为1，在最后一行数据之后只有2个新按钮，表示它已成功通过前2次运行和2，如果我调试，则rng设置为K28（这将是第3个新按钮的位置）。我保存工作簿，关闭它，重新打开它，然后运行完美第一次，第二次完美运行，然后第三次失败（再次在第三次运行CopyButton）。所以我退出代码，删除了两个新按钮并再次运行我的宏，它工作得很好。

显然，对于我提供的代码，如果我连续两次运行它而没有在新行的单元格F中放置任何内容，它将失败（访问被拒绝错误）（因为lRow将是相同的并且它将尝试将新按钮重命名为与工作表上已有的按钮相同的名称。因此，为了测试目的，在每次运行代码之后，我再次在运行宏之前在该单元格中添加了一些内容。

无论如何，我想我应该得到我收到的错误。每次我的代码失败时，它都会失败并出现以下错误：

运行时错误'1004'：

Worksheet类的粘贴方法失败

为这个长篇大论而道歉，但我想把所有东西放在桌面上。有人有什么建议吗？谢谢！

复制表单控件按钮的VBA宏失败

0 个答案: