自动生成菜单
文件夹下有N个exe可执行性文件,随时需要增加或减少个数。我想做一个界面,在菜单上显示所有exe文件名,点击文件名可直接打开文件夹下的exe文件,效果如图超级链接,谢谢
Private Sub Dir1_Change() File1.Path = Dir1.Path End Sub Private Sub Drive1_Change() Dir1.Path = Drive1.Drive End Sub Private Sub File1_DblClick() Dim temp As String temp = Dir1.Path & "\" & File1.FileName Call Shell(temp, vbNormalFocus) End Sub Private Sub Form_Load() File1.Pattern = "*.exe" End Sub
Option Explicit Dim apppath As String '保存着最后一次调用的路径 Private Sub Command1_Click() Call addlab("c:\windows\system32") '调用 End Sub Private Sub Form_Load() Label1(0).AutoSize = True '自动大小 Label1(0).ForeColor = &HFF0000 '文字颜色,还有一个鼠标图标,需要在属性里设置 Label1(0).Visible = False '不显示 Call addlab("c:\windows\") '调用,示例,这个与按钮的调用的路径不同,路径以最后一次调用为准 End Sub Public Sub addlab(p As String) Dim s As String Dim i As Long If Right(p, 1) <> "\" Then '标准化路径,是否带最后一个 \ apppath = p & "\" '不带,加上 Else apppath = p End If For i = 1 To Label1.Count - 1 '先删原有的 Unload Label1(i) Next i i = 1 s = Dir(apppath & "*.exe") '搜索 exe 文件 Do While s <> "" '找到 Load Label1(i) '加载一个 Label1(i).Caption = s '标题 s = Dir '下一个 i = i + 1 '计数器 Loop Call viewlab '排列 End Sub Public Sub viewlab() Const XR = 120 Const YR = 120 Dim i As Long Dim x As Long, y As Long x = XR y = YR '第一个元素需要特殊处理 Label1(1).Left = XR x = XR + Label1(1).Width Label1(1).Top = YR Label1(1).Visible = True '放完后显示 '从第二个元素开始 For i = 2 To Label1.Count - 1 If Label1(i).Width + XR + x > Me.ScaleWidth Then '如果本元素放上去会超出窗体 y = y + Label1(0).Height + YR '换到下一行 x = XR + Label1(i).Width Label1(i).Left = XR Label1(i).Top = y Else Label1(i).Left = x + XR '否则就放到本行 x = x + XR + Label1(i).Width Label1(i).Top = y End If Label1(i).Visible = True '放完后显示 Next i End Sub Private Sub Form_Resize() Call viewlab '改变窗体大小时,重新排列 End Sub Private Sub Label1_Click(Index As Integer) '单击时 If Dir(apppath & Label1(Index).Caption) <> "" Then '文件存在,防止显示列表后又把文件删掉,造成程序出错 Shell apppath & Label1(Index).Caption, vbNormalFocus '执行 Else MsgBox Label1(Index).Caption & " 已不存在,请检查!", vbCritical, "错误" End If End Sub