Excel 2003，如何获取范围的左上角和右下角？

Question

我有一个范围，我想检查一下上面是否放置了任何形状。

我在网上找到了一个脚本 (http://www.mrexcel.com/forum/excel-questions/317711-visual-basic-applications-identify-top-left-cell-selected-range.html)，但它不适用于 Excel 2003。我目前拥有的代码是根据找到的脚本改编的：

    Public Function removeOLEtypesOfType() As Boolean
        On Error Resume Next

        Dim objTopLeft As Range, objBotRight As Range _
          , objRange As Range, objShape As Shape
        Set objRange = Sheet1.Range(COLUMN_HEADINGS)
        objRange.Select

        With Selection
            Dim intFirstCol As Integer, intFirstRow As Integer _
              , intLastCol As Integer, intLastRow As Integer
            intFirstCol = .Column
            intFirstRow = .Row
            Set objTopLeft = .Cells(intFirstRow, intFirstCol) '.Address(0, 0)
            intLastCol = .Columns.Count + .Column - 1
            intLastRow = .Rows.Count + .Row - 1
            Set objBotRight = .Cells(intLastRow, intLastCol) '.Address(0, 0)

            If objTopLeft Is Nothing Or objBotRight Is Nothing Then
                MsgBox "Cannot get topleft or bottom right of range!", vbExclamation
                removeOLEtypesOfType = False
                Exit Function
            End If
            For Each objShape In ActiveSheet.Shapes
                Dim objTLis As Range
                Set objTLis = Intersect(objTopLeft, objShape.TopLeftCell)

                If Not objTLis Is Nothing Then
                    Dim objBRis As Range
                    Set objBRis = Intersect(objBotRight, objShape.BottomRightCell)

                    If Not objBRis Is Nothing Then
                        objShape.Delete
                    End If
                End If
            Next
        End With
        Sheet1.Cells(1, 1).Select
        removeOLEtypesOfType = True
    End Function

objTopLeft 和 objBotRight 都是 Nothing，COLUMN_HEADINGS 包含范围名称。

我在调试器中检查了 intFirstCol、intFirstRow、intLastCol 和 intLastRow，它们是正确的。

编辑... .Address 被注释掉后，topleft 和 botright 范围都被返回，但是 .Address 被返回，两者都没有。返回的范围似乎不适合正确的位置。

例如，对于提供的范围：

    intFirstCol = 3
    intFirstRow = 11
    intLastCol = 3
    intLastRow = 186

以上是正确的，但是：

    objTopLeft.Column = 5
    objTopLeft.Row = 21
    objBotRight.Column = 5
    objBotRight.Row = 196

以上不正确，列+2，行+10，为什么？

Answer 1

固定：

    Public Function removeOLEtypesOfType() As Boolean
        On Error Resume Next

        Dim objTopLeft As Range, objBotRight As Range _
          , objRange As Range, objShape As Shape
        Set objRange = Sheet1.Range(COLUMN_HEADINGS)
        objRange.Select

        With Selection
            Set objTopLeft = .Cells(1)
            Set objBotRight = .Cells(.Cells.Count)

            If objTopLeft Is Nothing Or objBotRight Is Nothing Then
                MsgBox "Cannot get topleft or bottom right of range!", vbExclamation
                removeOLEtypesOfType = False
                Exit Function
            End If
            For Each objShape In ActiveSheet.Shapes
                Dim blnTLcol As Boolean, blnTLrow As Boolean _
                  , blnBRcol As Boolean, blnBRrow As Boolean
                blnTLcol = (objShape.TopLeftCell.Column >= objTopLeft.Column)
                blnTLrow = (objShape.TopLeftCell.Row >= objTopLeft.Row)
                blnBRcol = (objShape.BottomRightCell.Column <= objBotRight.Column)
                blnBRrow = (objShape.BottomRightCell.Row <= objBotRight.Row)
                If blnTLcol = True And blnTLrow = True _
                And blnBRcol = True And blnBRrow = True Then
                    objShape.Delete
                End If
            Next
        End With
        Sheet1.Cells(1, 1).Select
        removeOLEtypesOfType = True
    End Function

谢谢@Ambie 我简化了例程，不能给你答案，因为这不是问题，但有助于清理代码。

Answer 2

这似乎是一种获取左上角和右下角的复杂方法，如果您的选择包括不连续的单元格，您的代码将无法工作。下面的代码可能更合适：

With Selection
    Set objTopLeft = .Cells(1)
    Set objBottomRight = .Cells(.Cells.Count)
End With

Answer 3

最简单的方法是创建一个从 Shape.TopLeftCell 到 Shape.BottomRightCell 的范围，然后测试这两个范围是否相交。

Set rShageRange = Range(objShape.TopLeftCell, objShape.BottomRightCell)

Sub FindShapesInRange()
    Dim objShape As Shape
    Dim rSearch As Range, rShageRange As Range

    Set rSearch = Range(COLUMN_HEADINGS)

    For Each sh In ActiveSheet.Shapes

        Set rShageRange = Range(objShape.TopLeftCell, objShape.BottomRightCell)

        If Not Intersect(sh.TopLeftCell, rSearch) Is Nothing Then

            Debug.Print "Shape Name: " & objShape.Name & " Shape Range: " & rShageRange.Address

        End If

    Next

End Sub

Excel 2003，如何获取范围的左上角和右下角？

Excel 2003, how to get top left and bottom right of range?

vba

range

excel-2003