|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
有些时候可能这样的对话框比msgbox有新意
我觉得用于跟随鼠标位置处提示时非常有用
稍微修改了一下 当用户未指定时弹出在屏幕中央 指定x1=1时 在当前鼠标位置弹出
另外使用的人要注意 这个弹出时 程序还是会中断的 就是说只有当点击了其他地方或者菜单项 菜单消失后才能继续执行后续代码- Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
- Sub MsgBoxa(myMessage, Optional myTitle As String, Optional myFaceid As Long, Optional x1 As Long, Optional y1 As Long) '菜单提示(提示内容,提示标题,图标,x位置,y位置)
- On Error Resume Next
- CommandBars("tmpContextMenu").Delete
- On Error GoTo 0
- Dim m As CommandBar, i%, regex1, c
- Set m = CommandBars.Add("tmpContextMenu", msoBarPopup)
- Set regex1 = CreateObject("VBSCRIPT.REGEXP") 'RegEx为建立正则表达式
- With regex1
- .Global = True '设置全局可用
- .Pattern = ".+"
- End With
- '--------------------------------------------------
- With m
- '--------------------------------------------------
- With .Controls.Add(msoControlButton, , , , True) '添加新按钮
- If myTitle = "" Then .Caption = "★SoSo提示您★" Else .Caption = myTitle
- .FaceId = 1954
- End With
- '--------------------------------------------------
- Set c = regex1.Execute(myMessage)
- If c.Count > 0 Then
- For i = 0 To c.Count - 1
- With .Controls.Add(msoControlButton, , , , True) '添加新按钮
- .Caption = c.Item(i).Value
- If i = 0 Then .FaceId = myFaceid: .BeginGroup = True
- End With
- Next i
- End If
- '--------------------------------------------------
- If x1 + y1 = 0 Then x1 = (GetSystemMetrics(0) - .Width) / 2: y1 = (GetSystemMetrics(1) - .Height) / 2
- '----用户未指定位置显示在屏幕中央-----------------------------------
- If x1 = 1 Then
- .ShowPopup 'x1=1则弹出菜单在当前鼠标位置
- Else
- .ShowPopup x1, y1
- End If
- End With
- End Sub
- Sub test()
- MsgBoxa "你好,我是一个提示框", "我的", , 1
- Debug.Print 1
- End Sub
复制代码 |
|