Excel 2013 停止在 sub 中工作

Question

我正在使用 VBA 代码，它会在单元格选择器移动时突出显示活动单元格的边框颜色。

密码是

Private mOutline As Shape  
Private Const SelectedShapeName As String = "Selection Box"

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    Dim SelectedShape As Shape
    Dim SelectedArea As Range

    On Error Resume Next
    For Each SelectedShape In Sh.Shapes
        If SelectedShape.Name = SelectedShapeName Then
            SelectedShape.Delete
        End If
    Next SelectedShape

    For Each SelectedArea In Selection.Areas
        Set mOutline = ActiveSheet.Shapes.AddShape(msoShapeRectangle, SelectedArea.Left, SelectedArea.Top, SelectedArea.Width, SelectedArea.Height)
        With mOutline.OLEFormat.Object.ShapeRange
            .Fill.Visible = msoFalse
            .Line.ForeColor.RGB = RGB(255, 0, 0)
            .Line.Transparency = 0
            .Line.Weight = 3
        End With
        mOutline.Name = SelectedShapeName
    Next SelectedArea
    On Error GoTo 0 End Sub

当我 right-click 在我的工作表中的列 header 上时，Excel 突然停止工作并存在。

有人知道导致此错误的原因吗？如果知道，我该如何修改我的代码以避免此错误？

谢谢。

Answer 1

您的代码试图添加的形状太高 Excel 无法处理。当你右击时，它选择了整个列，所以 SelectedArea.Top 是 0 而 SelectedArea.Height 是一些大得离谱的数字（在我的机器上是 15728640）。这导致 ActiveSheet.Shapes.AddShape 失败。

完全删除 On Error Resume Next 行。您忽略了 1004 错误而不是处理它。然后下一行代码尝试取消对不存在的 OLEObject 的引用（这将是第二个被忽略的错误），然后尝试将属性分配给空引用（这将是第三个被忽略的错误）。我不打算测试找出哪个导致 Excel 关闭，但我猜测第二个或第三个导致访问冲突。

要么添加适当的错误处理，要么更好地通过测试您是否有有效的 Target:

来避免错误

'Assuming you want to limit to one cell
If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then Exit Sub

Excel 2013 停止在 sub 中工作

Excel 2013 stops working in sub

error-handling

excel

vba

excel-2013