Question

计划：Excel 2016。

我有一张有很多形状的纸张。每个都有自己的特定名称，其中大部分都是标签。我想改变他们的标题属性，但我找不到方法，但是像这样逐个调用它们：

    LblLabel_1.Caption = ...
    LblLabel_2.Caption = ...
    LblLabel_3.Caption = ...

相反，我正在寻找这样的东西：

    For BytCounter01 = 1 to 255
        Shapes("LblLabel_" & BytCounter01).Caption = ...
    Next

这个将导致错误438，基本上说Caption不适用于此对象。它仍然以对象为目标，因为这段代码：

    Debug.print Shapes("LblLabel_" & BytCounter01).Name

会给我回复它的名字。

寻找解决方案：

-i尝试过控制（＆＃34; LblLabel _＆＃34;＆amp; BytCounter01）而不是Shapes（＆＃34; LblLabel _＆＃34;＆amp; BytCounter01）但是自从控制后它无法工作仅适用于用户表单，不适用于工作表;

-i尝试过Shapes（＆＃34; LblLabel _＆＃34;＆amp; BytCounter01）.TextFrame.Characters.Text但它再次返回错误438;

- 因为标签是一个群组的一部分，我已经尝试了两个

    Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).Caption

和

    Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).TextFrame.Characters.Text

但又得了438。

是否真的没有办法轻松定位工作表上的特定标签并更改其标题？

谢谢。

编辑：感谢Excelosaurus，问题解决了。由于我的标签是ActiveX控件，我必须使用这样的东西：

    For BytCounter01 = 1 to 255
        Shapes("LblLabel_" & BytCounter01)OLEFormat.Object.Object.Capti‌on = ...
    Next

您可以查看他的回复和评论以获取更多详细信息。再次感谢Excelosaurus！

Answer 1

您无法为形状指定Caption。 （形状没有字幕）。一种方法是遍历Shapes并构建一个小表来告诉你接下来要循环的内容：

Sub WhatDoIHave()
    Dim kolumn As String, s As Shape
    Dim i As Long, r As Range

    kolumn = "Z"
    i = 1

    For Each s In ActiveSheet.Shapes
        Set r = Cells(i, kolumn)
        r.Value = i
        r.Offset(, 1).Value = s.Name
        r.Offset(, 2).Value = s.Type
        r.Offset(, 3).Value = s.TopLeftCell.Address(0, 0)
        i = i + 1
    Next s

End Sub

我的样本产生了哪些：

看到我有两个Forms和ActiveX （OLE）控件，我知道下一步要循环什么。然后，我引用数字控制并在适当的时候分配标题。

Answer 2

要更改形状的文字内容，请使用.TextFrame2.TextRange.Text，如下所示：

shtShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption

其中shtShapes是工作表对象的名称，如Project Explorer中的Visual Basic编辑器所示，

sShapeName是一个字符串变量，包含目标形状的名称和

sShapeCaption是一个包含所需标题的字符串变量。

下面是一个代码示例。我已经抛出了一个函数来检查工作表上的形状是否存在，名称。

Option Explicit

Public Sub SetLabelCaptions()
    Dim bCounter As Byte
    Dim sShapeName As String
    Dim sShapeCaption As String

    For bCounter = 1 To 255
        sShapeName = "LblLabel_" & CStr(bCounter)

        If ShapeExists(shtMyShapes, sShapeName) Then
            sShapeCaption = "Hello World " & CStr(bCounter)
            shtMyShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
        Else
            Exit For
        End If
    Next
End Sub

Public Function ShapeExists(ByVal pshtHost As Excel.Worksheet, ByVal psShapeName As String) As Boolean
    Dim boolResult As Boolean
    Dim shpTest As Excel.Shape

    On Error Resume Next
    Set shpTest = pshtHost.Shapes(psShapeName)
    boolResult = (Not shpTest Is Nothing)
    Set shpTest = Nothing

    ShapeExists = boolResult
End Function

结果应如下所示：

如何在Excel工作表中定位特定形状

2 个答案: