excel 获取特定单元格中的形状名称

utugiqy6  于 2023-03-13  发布在  其他
关注(0)|答案(1)|浏览(210)

我有一些椭圆形的形状在活动表,我试图返回形状名称从特定的单元格使用以下udf

Sub Test()
    Debug.Print GetShapeName(Range("J10"))
End Sub

Function GetShapeName(cell As Range) As String
    Dim shp As Shape
    For Each shp In cell.Parent.Shapes
        If Not Application.Intersect(shp.TopLeftCell.MergeArea, cell) Is Nothing Then
            GetShapeName = shp.Name
            Exit Function
        End If
    Next shp
    GetShapeName = ""
End Function

但是我得到的结果是空的。我试着删除MergeArea,但是还是出现了同样的问题。如果有帮助的话,可以用下面的代码来绘制形状

Sub VBA_Circle_Text()
    Dim cel As Range, m As Double, n As Double
    Set cel = Application.Selection
    With cel
        m = .Height * 0.1
        n = .Width * 0.1
        Application.ActiveSheet.Ovals.Add Top:=.Top - m, Left:=.Left - n, Height:=.Height + 2.25 * m, Width:=.Width + 1.75 * n
        With Application.ActiveSheet.Ovals(ActiveSheet.Ovals.Count)
            .Interior.ColorIndex = xlNone
            With .ShapeRange.Line
                .Weight = 2
                .ForeColor.RGB = vbRed
            End With
        End With
    End With
    cel.Select
End Sub
dohp0rv5

dohp0rv51#

Function GetShapeName(cell As Range) As String
    Dim shp As Shape, ws As Worksheet
    Set ws = cell.Parent
    For Each shp In ws.Shapes
        If Not Application.Intersect(ws.Range(shp.TopLeftCell.Address & ":" & shp.BottomRightCell.Address), cell) Is Nothing Then
            GetShapeName = shp.Name
            Exit Function
        End If
    Next shp
    GetShapeName = ""
End Function

以及一个变量,该变量返回一个包含该范围内所有形状名称的数组

Function GetShapesNames(cell As Range) As Variant
    Dim shp As Shape, ws As Worksheet, result As String
    Set ws = cell.Parent
    For Each shp In ws.Shapes
        If Not Application.Intersect(ws.Range(shp.TopLeftCell.Address & ":" & shp.BottomRightCell.Address), cell) Is Nothing Then
            result = (result & IIf(result <> "", ",", "") & shp.Name)
        End If
    Next shp
    GetShapesNames = Split(result, ",")
End Function

相关问题