[已解决]点击形状改变显示文字

chmmm

我画了这样一个形状，怎样实现：我点击它一次，文字“展开”->"收起"，再点击一次，“收起”->“展开”。应该可以实现吧？请高手指教，谢谢。

最佳答案

月排行榜 / 总排行榜

爱疯

2013-7-10 12:02

Sub b()
    Dim r&
    With ActiveSheet
        r = .UsedRange.Rows.Count
        .Rows("2:" & r).RowHeight = IIf(.Range("a2").Height, 0, 13.5)
        .Shapes(1).TextFrame2.TextRange.Characters.Text = IIf(.Range("a2").Height, "收起", "展开")
    End With
End Sub
求助2.rar (15.55 KB, 下载次数: 99)

2013-7-10 11:59 上传

点击文件名下载附件
楼上回复都对，这是楼主上次提问的附件。
2楼说的对，上传附件，问题才好快速解答

跳转到最佳答案楼层

w2001pf

发个附件嘛。

liuguansky

1. Sub df()
   
2.     With ActiveSheet.Shapes(1).TextFrame2.TextRange.Characters
   
3.         If .Text = "展开" Then
   
4.             .Text = "收起"
   
5.         ElseIf .Text = "收起" Then
   
6.             .Text = "展开"
   
7.         End If
   
8.     End With
   
9. End Sub
   

复制代码

把这个形状指定给这个宏就可以了。

hwc2ycy

1. Sub 圆角矩形1_Click()
   
2.     Dim shp As Shape
   
3.     Set shp = ActiveSheet.Shapes(1)
   
4.     With shp.TextEffect
   
5.         Select Case .Text
   
6.             Case "展开"
   
7.                 .Text = "收起"
   
8.             Case "收起"
   
9.                 .Text = "展开"
   
10.         End Select
    
11.     End With
    
12.    
    
13. End Sub

复制代码

爱疯

Sub b()
    Dim r&
    With ActiveSheet
        r = .UsedRange.Rows.Count
        .Rows("2:" & r).RowHeight = IIf(.Range("a2").Height, 0, 13.5)
        .Shapes(1).TextFrame2.TextRange.Characters.Text = IIf(.Range("a2").Height, "收起", "展开")
    End With
End Sub
求助2.rar (15.55 KB, 下载次数: 99)

2013-7-10 11:59 上传

点击文件名下载附件
楼上回复都对，这是楼主上次提问的附件。
2楼说的对，上传附件，问题才好快速解答

chmmm

爱疯 发表于 2013-7-10 12:02
Sub b()
    Dim r&
    With ActiveSheet

谢谢谢谢。以后一定都带附件。