excel - Excel 2013停止在子工作

Question

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

该代码是

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

当我右键单击工作表中的列标题时，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