自动生成菜单
文件夹下有N个exe可执行性文件,随时需要增加或减少个数。我想做一个界面,在菜单上显示所有exe文件名,点击文件名可直接打开文件夹下的exe文件,效果如图超级链接,谢谢
2015-05-20 17:48

2015-05-20 20:48
2015-05-20 21:19
程序代码: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

2015-05-21 09:24
程序代码: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

2015-05-21 09:48

2015-05-21 09:58
2015-05-21 10:13
2015-05-21 12:20
2015-05-21 12:24
2015-05-21 13:54