Можете ли вы выбрать форму напрямую, если вы знаете ее строку и столбец

Question

у меня ок. 100 прямоугольников на листе. Я хочу изменить цвет определенного прямоугольника, для которого я знаю его TopLeftCell координаты.

Я хочу иметь возможность непосредственно выбрать этот прямоугольник, чтобы изменить его цвет, но я не могу найти какой-либо код VBA для этого. В настоящее время единственный код, который я могу найти, выбирает все фигуры на листе, а затем ищет пересечение каждой фигуры на листе с помощью TopLeftCell, чтобы затем выбрать этот прямоугольник, чтобы изменить его цвет.

С проверкой, возможно, 100 фигур, этот метод кажется очень неэффективным, и я думаю, что должен быть лучший способ.

Dim sh as shape

For Each sh In ActiveSheet.Shapes
    If Not Intersect(Cells(RowNumber, ColumnNumber), sh.TopLeftCell) Is Nothing Then
        sh.Select False
        Selection.Interior.ColorIndex = 3
        Selection.ShapeRange.Fill.Visible = msoTrue
        Selection.ShapeRange.Fill.Solid
    End If
Next sh

Интересно, будет ли такой код, как

selection.shape.topleftcell(cells(RowNumber,ColumnNumber))

или аналогичный возможен в VBA.
Я пробовал этот и другой подобный код, но все выдают ошибки.

Answer 1

Запустите loop, как это один раз, чтобы изменить имена Rectangles на адрес их TopLeftCell

 Dim sh As Shape

 For Each sh In ActiveSheet.Shapes

    sh.Name = sh.TopLeftCell.Address

 Next sh

---

Теперь в любом другом коде вы можете напрямую получить доступ к фигуре, используя:

ActiveSheet.Shapes(ActiveCell.Address).Select

Это один из способов, которым вы можете достичь этого. Хотя не существует метода, который вы ищете.

Вы можете изменить ActiveCell.Address любой объект диапазона или, возможно, только сам текст. Это будет принимать значения, такие как $D$4

Пробовал и проверял, работает плавно.

Answer 2

Если все, что вы делаете, это Select форму, которую вы хотите изменить цвет, то просто:

Sub changeColor()
    Selection.Interior.ColorIndex = 3
End Sub

Если вы хотите получить доступ к другим свойствам Shape более организованно, я бы предложил собрать имена Shape в Словаре с ключом TopLeftCell. Тогда вы можете сделать что-то вроде:

Option Explicit
'Set Reference to Microsoft Scripting Runtime
Public dShapes As Dictionary
Private Sub refShapes()
    Dim WS As Worksheet
    Dim SH As Shape

Set WS = ActiveSheet
Set dShapes = New Dictionary
    dShapes.CompareMode = TextCompare
For Each SH In WS.Shapes
    dShapes.Add Key:=SH.topLeftCell.Address, Item:=SH.Name
Next SH

End Sub

Sub changeColor()
    Dim SH As Shape
    Dim topLeftCell As String

topLeftCell = Selection.topLeftCell.Address

refShapes

If dShapes.Exists(topLeftCell) Then
    Set SH = ActiveSheet.Shapes(dShapes(topLeftCell))
    SH.Fill.ForeColor.RGB = RGB(255, 0, 255)
    SH.Fill.Visible = msoTrue
    SH.Fill.Solid
Else
    MsgBox ("No shape at that location")
End If
End Sub

Однако , эта техника потерпит неудачу, если у вас более одной фигуры с одним и тем же TopLeftCell, но она может быть адаптирована для обработки этой ситуации при необходимости.