不一样的msgbox，要不你也试试

huanglicheng · 发表于 2014-4-16 12:38

本帖最后由 huanglicheng 于 2014-4-18 14:25 编辑

不久前在别人贴中回过，现在分享出来。说不定你会喜欢。你可以改成你喜欢的样式，或者改做其他更广泛的用途。

代码在18楼有更新
利用菜单的形式做提示框：不需点确定

单行提示： MsgBoxa ("你好,我是一个提示框")
360软件小助手截图20140416123648.png

多行提示： MsgBoxa ("你好,我是一个提示框" & vbLf & "关闭我非常简单，随便哪点一下即可")
360软件小助手截图20140416123634.png

调用方式

Sub test()
MsgBoxa ("你好,我是一个提示框")
End Sub

复制代码

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%
Set m = CommandBars.Add("tmpContextMenu", msoBarPopup)
'--------------------------------------------------
If x1 = 0 Then x1 = 400
If y1 = 0 Then y1 = 400
'--------------------------------------------------
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
'--------------------------------------------------
.ShowPopup x1, y1
End With
End Sub

复制代码

test.zip (11.38 KB, 下载次数: 425)

dajiahaoxinku12 · 发表于 2014-4-16 12:56

支持原创，很新颖独特，感谢分享。

liuxingcsu · 发表于 2014-4-16 13:05

可惜看不懂

yf_home · 发表于 2014-4-16 13:13

好，不错。

提个建议，如果能封装到类，然后所有模块，可以直接调用就更好了。

.

百度不到去谷歌 · 发表于 2014-4-16 13:21

有些时候可能这样的对话框比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

复制代码

xsy我可以很好 · 发表于 2014-4-16 13:23

喜欢有创意的东西

huanglicheng · 发表于 2014-4-16 14:00

以下是我用菜单做的提示+标记功能（功能延伸）多功能数据统计

huanglicheng · 发表于 2014-4-16 14:09

百度不到去谷歌发表于 2014-4-16 13:21
有些时候可能这样的对话框比msgbox有新意
我觉得用于跟随鼠标位置处提示时非常有用
稍微修改了一下当用户 ...

嗯嗯。你这样改改更人性化。

huanglicheng · 发表于 2014-4-16 14:11

yf_home 发表于 2014-4-16 13:13
好，不错。

提个建议，如果能封装到类，然后所有模块，可以直接调用就更好了。

呵呵，封装到类咱还不会。后期会放到SoSo工具集中去

yf_home · 发表于 2014-4-16 18:21

huanglicheng 发表于 2014-4-16 14:00
以下是我用菜单做的提示+标记功能（功能延伸）多功能数据统计

这个右键菜单定义的不错。
有源码分享不，咋也学习一下。

...

		自动登录	找回密码
密码			免费注册

[原创] 不一样的msgbox，要不你也试试

评分