很有用的主窗体

一指禅62

老鬼公公_31 发表于 2017-10-30 10:39
老师，二级菜单这里怎样点击链接到窗体，比例员工档案，窗休的名字也是员工档案

1、类模块中的代码稍作修改

1. Private Sub labMenu_Click()
   
2.     Main.labView.Caption = Key1 & "" & Key2
   
3.     'MsgBox "现在运行【" & Key2 & "】程序", vbInformation, Key2
   
4.     On Error GoTo 123 ' Resume Next
   
5.     Call Application.Run(Key2)
   
6.     Exit Sub
   
7. 123:
   
8.     MsgBox "请添加“" & Key2 & "”宏"
   
9. End Sub

复制代码

2、模块中写入代码

1. Sub 员工档案()
   
2.     'MsgBox "现在运行“员工档案”的宏"
   
3.     frm员工档案.Show
   
4. End Sub

复制代码

02761752696

学习学习  谢谢分享

老鬼公公_31

老师在吗，二级菜单怎样进入窗体啊

老鬼公公_31

老师，二级菜单这里怎样点击链接到窗体，比例员工档案，窗休的名字也是员工档案

afdadas

谢谢分享！！

一指禅62

一指禅62 发表于 2014-3-1 15:03
用到了类模块的

主界面设计（类模块的）.rar (129.1 KB, 下载次数: 263)

2014-3-21 19:41 上传

点击文件名下载附件

sangweidd

谢谢楼主分享，收藏了！

常州海达装潢

好东西，收藏学习了！

一指禅62

【窗体代码】

1. Option Explicit
   
2. 
   
3. Private Col As New Collection
   
4. 
   
5. Private Sub UserForm_Initialize()
   
6. Dim mc As ClsButton
   
7. Dim lab As Control
   
8. For Each lab In Me.Controls
   
9. If lab.Name Like "labButton*" Then
   
10. Set mc = New ClsButton
    
11. Set mc.iLabel = lab
    
12. Col.Add mc
    
13. Set mc = Nothing
    
14. End If
    
15. If lab.Name Like "labMenu*" Then
    
16. Set mc = New ClsButton
    
17. Set mc.labMenu = lab
    
18. Col.Add mc
    
19. Set mc = Nothing
    
20. End If
    
21. Next
    
22. labYm.Caption = Format(Date, "yyyy年mm月")
    
23. labDy.Caption = Format(Date, "dd")
    
24. labWk.Caption = Format(Date, "aaaa")
    
25. End Sub
    

复制代码

一指禅62

【类模块ClsButton 代码】

1. Option Explicit
   
2. 
   
3. Public WithEvents iLabel As MSForms.Label
   
4. Public WithEvents labMenu As MSForms.Label
   
5. 
   
6. Private Sub iLabel_Click()
   
7. Dim clt As Control, i As Integer
   
8. For Each clt In Main.Controls '标签属性还原
   
9. If clt.Name Like "labButton*" Then
   
10. clt.BackColor = &H8000000F
    
11. clt.Font.Size = 10
    
12. clt.ForeColor = &HC0C000
    
13. End If
    
14. If clt.Name Like "labMenu*" Then
    
15. clt.Caption = ""
    
16. clt.Visible = False
    
17. End If
    
18. Next
    
19. Rem 设置选中标签 labButton 的属性
    
20. Dim Index As Integer
    
21. Index = Mid(iLabel.Name, 10, Len(iLabel.Name) - 9)
    
22. With Main.Controls("labButton" & Index)
    
23. .BackColor = &H80000016
    
24. .Font.Size = 12
    
25. .ForeColor = &HC0&
    
26. Key1 = .Caption '获取主菜单名称
    
27. End With
    
28. Main.labView.Caption = Key1
    
29. Rem 修改九宫格labMenu标签属性
    
30. Dim arr, k As Integer, myPath As String
    
31. arr = Sheet2.UsedRange
    
32. For i = 1 To UBound(arr)
    
33. If arr(i, 2) = Key1 Then
    
34. myPath = ThisWorkbook.Path & "\Image" & Key1 & "" & arr(i, 3) & ".ico"
    
35. With Main.Controls("labMenu" & arr(i, 4))
    
36. .Caption = arr(i, 3)
    
37. .Picture = LoadPicture(myPath)
    
38. .Visible = True
    
39. End With
    
40. End If
    
41. Next
    
42. End Sub
    
43. 
    
44. Private Sub labMenu_Click()
    
45. Main.labView.Caption = Key1 & "" & Key2
    
46. MsgBox "现在运行【" & Key2 & "】程序", vbInformation, Key2
    
47. End Sub
    
48. 
    
49. Private Sub labMenu_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    
50. Dim ctl As Control, Index As Integer
    
51. For Each ctl In Main.Controls
    
52. If ctl.Name Like "labMenu*" Then
    
53. ctl.Font.Size = 10
    
54. ctl.SpecialEffect = fmSpecialEffectFlat
    
55. End If
    
56. Next
    
57. Index = Mid(labMenu.Name, 8, Len(labMenu.Name) - 7)
    
58. With Main.Controls("labMenu" & Index)
    
59. .Font.Size = 12
    
60. .SpecialEffect = fmSpecialEffectRaised
    
61. End With
    
62. Key2 = labMenu.Caption
    
63. End Sub
    

复制代码