如果您知道形状的左上单元格行和行，可以直接选择它吗?柱子 [英] Can you select a shape directly, if you know its topleftcell row & column

问题描述

我大约有.一张纸上的100个矩形.我想更改其 TopLeftCell 坐标的特定矩形的颜色.

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.

我希望能够直接选择此矩形来更改其颜色，但是我找不到任何VBA代码来执行此操作.目前，我能找到的唯一代码是，选择工作表上的所有形状，然后在工作表上查找每个形状与 TopLeftCell 的交集，然后选择该矩形以更改其颜色

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.

可能要检查100个形状，这似乎是一种效率很低的方法，我认为必须有更好的方法.

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))

或类似的在VBA中是可能的.
我尝试了这种方法以及其他类似的代码，但是都给出了错误.

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

推荐答案

如果您要做的只是选择要更改颜色的形状，则只需:

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

如果要以更有条理的方式访问Shape的其他属性，我建议使用TopLeftCell作为键在Dictionary中收集Shape名称.然后，您可以执行以下操作:

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

但是，如果您有多个具有相同 TopLeftCell 的形状，则该技术将失败，但可以根据需要进行调整以解决这种情况.

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.

这篇关于如果您知道形状的左上单元格行和行，可以直接选择它吗?柱子的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！