三角箭头显示下拉菜单

Shony

VBA新手求助各位大虾：一通操作以后，“课程1”明明是折叠状态，为什么三角箭头向下了？操作步骤写在附件里了。

mmwwdd

我下载了,正常呀

Shony

mmwwdd 发表于 2020-3-16 11:00
我下载了,正常呀

仔细看我的操作步骤，不要把“课程1”箭头折叠回去，多余步骤不要做。

mmwwdd

呵呵,这是你少点击了一下,图形没有翻转过来

mmwwdd

  ActiveSheet.Shapes.Range(Array("Isosceles Triangle 2")).IncrementRotation 180
这条语句是顺时针180度,点击完图形翻一下,你少 点一下,当然还是朝下

山菊花

不要使用IncrementRotation属性，它不能识别上下方向，可改用Rotation属性。

lsdongjh

功能性重构，可读性、可编辑性更强

1. Option Explicit
   
2. 
   
3. Enum enuState
   
4.     Collapse = True
   
5.     Expand = False
   
6. End Enum
   
7. 
   
8. Dim blAct(3) As Boolean '菜单状态。0为主菜单，1-3对应3个子菜单
   
9. 
   
10. 
    
11. Sub 主菜单()
    
12.     blAct(0) = Not blAct(0)
    
13.     If Not blAct(0) Then 一级菜单 Expand Else 一级菜单 Collapse
    
14. End Sub
    
15. 
    
16. Sub 课程1()
    
17.     blAct(1) = Not blAct(1)
    
18.     If Not blAct(1) Then 二级菜单_课程1 Expand Else 二级菜单_课程1 Collapse
    
19. End Sub
    
20. 
    
21. Sub 课程2()
    
22.     blAct(2) = Not blAct(2)
    
23.     If Not blAct(2) Then 二级菜单_课程2 Expand Else 二级菜单_课程2 Collapse
    
24. End Sub
    
25. 
    
26. Sub 课程3()
    
27.     blAct(3) = Not blAct(3)
    
28.     If Not blAct(3) Then 二级菜单_课程3 Expand Else 二级菜单_课程3 Collapse
    
29. End Sub
    
30. 
    
31. 
    
32. 
    
33. 
    
34. Function 一级菜单(Act As enuState)
    
35.     If Act = Expand Then
    
36.         SetMenuState 3, Array(4, 8, 13), "等腰三角形 1", Act, Array("等腰三角形 2", "等腰三角形 3", "等腰三角形 4"), "3:18"
    
37.     Else
    
38.         SetMenuState 3, Array(4, 8, 13), "等腰三角形 1", Act, , "3:18"
    
39.     End If
    
40. End Function
    
41. 
    
42. Function 二级菜单_课程1(Act As enuState)
    
43.     SetMenuState 4, Array(5, 6, 7), "等腰三角形 2", Act
    
44. End Function
    
45. 
    
46. Function 二级菜单_课程2(Act As enuState)
    
47.     SetMenuState 8, Array(9, 10, 11, 12), "等腰三角形 3", Act
    
48. End Function
    
49. 
    
50. Function 二级菜单_课程3(Act As enuState)
    
51.     SetMenuState 13, Array(14, 15, 16, 17), "等腰三角形 4", Act
    
52. End Function
    
53. 
    
54. 
    
55. Function SetMenuState(ParentID As Long, ChildID As Variant, ShapeName As Variant, Act As enuState, Optional ChildShapeName As Variant = "", Optional strArea As String = "")
    
56.     Dim arrChildID As Variant, arrShapeName As Variant, arrChildShapeName As Variant
    
57.     Dim lngID As Long
    
58.    
    
59.     '初始化子节点
    
60.     If IsArray(ChildID) Then
    
61.         arrChildID = ChildID
    
62.     Else
    
63.         ReDim arrChildID(0)
    
64.         arrChildID(0) = CLng(ChildID)
    
65.     End If
    
66.    
    
67.     '初始标志符
    
68.     If IsArray(ShapeName) Then
    
69.         arrShapeName = ShapeName
    
70.     Else
    
71.         ReDim arrShapeName(0)
    
72.         arrShapeName(0) = ShapeName
    
73.     End If
    
74.    
    
75.     '初始子节点标志符
    
76.     If IsArray(ChildShapeName) Then
    
77.         arrChildShapeName = ChildShapeName
    
78.     Else
    
79.         ReDim arrChildShapeName(0)
    
80.         arrChildShapeName(0) = ChildShapeName
    
81.     End If
    
82.    
    
83.     '如果有指定区域，先隐藏所有区域
    
84.     If strArea <> "" Then ActiveSheet.Rows(strArea).Hidden = True
    
85.    
    
86.     '显示主菜单
    
87.     ActiveSheet.Rows(ParentID).Hidden = False
    
88.    
    
89.     '显示隐藏子菜单
    
90.     For lngID = LBound(arrChildID) To UBound(arrChildID)
    
91.         ActiveSheet.Rows(arrChildID(lngID)).Hidden = Act
    
92.     Next
    
93.    
    
94.     '改变标志符
    
95.     For lngID = LBound(arrShapeName) To UBound(arrShapeName)
    
96.         ActiveSheet.Shapes(arrShapeName(lngID)).Rotation = (Not Act) * 180
    
97.     Next
    
98.    
    
99.     '改变子节点标志符
    
100.     If arrChildShapeName(0) <> "" Then
     
101.         For lngID = LBound(arrChildShapeName) To UBound(arrChildShapeName)
     
102.             ActiveSheet.Shapes(arrChildShapeName(lngID)).Rotation = 0
     
103.         Next
     
104.     End If
     
105. End Function
     
106. 
     
107. 
     
108. 
     
109. 
     
110. 
     

复制代码