Can you select a shape directly, if you know its topleftcell row & column

问题

I have approx. 100 rectangles on a sheet. I want to change the color of a particular rectangle for which I know its TopLeftCell co-ordinates.

I want to be able to directly select this rectangle to change its color, but I cannot find any VBA code to do this. Currently, the only code I can find, selects all shapes on the sheet, and then looks for an intersection of each of the shapes on the sheet with the TopLeftCell, to then select that rectangle to change its color.

With maybe 100 shapes to check, this seems a very inefficient method, and I think there must be a better way.

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

I wonder if a code like

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

or similar would be possible in VBA.
I tried this and other like code, but all give errors.

回答1:

If all you are doing is Selecting the shape you wish to change the color, then merely:

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

IF you want to access other properties of the Shape in a more organized fashion, I would suggest collecting the Shape names in a Dictionary with the TopLeftCell as the key. Then you can do something like:

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

However, this technique will fail if you have more than one shape with the same TopLeftCell, but could be adapted to handle that situation if necessary.

回答2:

Run a loop like this once to change the names of the Rectangles to the Address of their TopLeftCell

 Dim sh As Shape

 For Each sh In ActiveSheet.Shapes

    sh.Name = sh.TopLeftCell.Address

 Next sh

Now in any other code you can directly access the shape using:

ActiveSheet.Shapes(ActiveCell.Address).Select

This is one way you can achieve it. Though there doesn't exist a method that you are looking for.

You can change the ActiveCell.Address any range object or maybe just the text itself. It will take values like $D$4

Tried and Tested, it works Smoothly.

来源：https://stackoverflow.com/questions/56609506/can-you-select-a-shape-directly-if-you-know-its-topleftcell-row-column

标签

excel

vba

shapes