尝试为 Excel 中的形状命名/标题

编程问答 2022-04-22

问题描述

我试图从另一个工作簿复制一个子程序，原始工作簿中的子程序工作正常，但我的不起作用。两个子程序的语法相同 子：

Sub figurMedTittel_Klikk()

    Dim Tittel As String
    
    Tittel = ActiveSheet.Shapes(Application.Caller).Title
    
    Select Case Tittel
    Case "BME"
        Range(Tittel).EntireRow.Hidden = False
        Range("BMA").EntireRow.Hidden = True
        Range("Kompleks").EntireRow.Hidden = True
    Case "BMA"
        Range(Tittel).EntireRow.Hidden = False
        Range("BME").EntireRow.Hidden = True
        Range("Kompleks").EntireRow.Hidden = True
    Case "Kompleks"
        Range(Tittel).EntireRow.Hidden = False
        Range("BMA").EntireRow.Hidden = True
    End Select

End Sub

带有 sub 的点是通过单击形状来显示或隐藏具有与形状标题相同的定义名称的一系列行。问题似乎是我找不到给形状（矩形）一个标题的方法。

当我尝试运行代码时，出现错误“运行时错误'-2147352571 (80020005)'”。我是 VBA 新手，这是我第一次在 Stackoverflow 中提问。我希望这是可以理解的。

解决方法

我在阅读 .Title 属性时运气不佳 - 您可以使用形状中的文本或其 AlternativeText（通过 Excel 绘图工具 > 格式 > 替换文本设置）

Sub FigurMedTittel_Klikk()

    Dim shp As Shape,txt
    
    txt = Application.Caller
    
    'or  one of these other methods...
    'Set shp = ActiveSheet.Shapes(Application.Caller)
    'txt = shp.TextFrame2.TextRange.Text 
    'txt = shp.AlternativeText
    
    For Each r In Array("BME.","BMA.","Kompleks.")
        Range(Replace(r,".","")).EntireRow.Hidden = (txt <> r)
    Next r
     
End Sub
,

我已经设法对其进行了一些修改，现在它可以工作了。我认为问题是不再可能给形状一个标题。新子程序：

Sub FigurMedTittel_Klikk()

Dim Tittel As String
Dim RowTittel As String
Tittel = ActiveSheet.Shapes(Application.Caller).Name
RowTittel = Replace(Tittel,"") 

Select Case Tittel
Case "BME." 
    Range(RowTittel).EntireRow.Hidden = False
    Range("BMA").EntireRow.Hidden = True
    Range("Kompleks").EntireRow.Hidden = True
Case "BMA."
    Range(RowTittel).EntireRow.Hidden = False
    Range("BME").EntireRow.Hidden = True
    Range("Kompleks").EntireRow.Hidden = True
Case "Kompleks."
    Range(RowTittel).EntireRow.Hidden = False
    Range("BMA").EntireRow.Hidden = True
End Select

结束子

excelexcelshapestitlevba