![9398b1ef79bb69961a0fba57b8574d76.png](https://i-blog.csdnimg.cn/blog_migrate/9417f0a400a1fa3e271edd9c47f02315.png)
这是我平常总结工作的时候,会运用到一些VBA知识解决的小案例。
通常,我们接收到一些工作表,表格界面没有一定程序的简化,比方说:网络线没有删除,横纵坐标(1-N;A-ZZ..),垂直水平滚动条没有隐藏等等。本章总结了以下的知识点:
1# Application 对象(Excel界面)上的用法
2# ActiveWindow 属性,同样对Excel界面进行操作
3# 自定义(鼠标)右击的快捷菜单
4# 功能的开关设置
5# API 函数 定时的消息框MessageboxtimeoutA
6# 工作簿事件(Open)/ 工作表事件(BeforeRightClick)
7# Environ("userprofile") / Environ("username") 返回机主缩写名称
使用简化界面功能,如下图:
![a2ceec1ee0def83018affd5405162dbd.png](https://i-blog.csdnimg.cn/blog_migrate/2cd051538770806d51759e6ea69eb9cd.jpeg)
原版还没有使用之前:
![511fdd93a776e44144308884233f4c72.png](https://i-blog.csdnimg.cn/blog_migrate/871c97641bcf68067462b5eff92bcc8c.jpeg)
以下是简化界面的代码:
Sub SimplifiedScreen()
'简化界面
Dim Sht As Worksheet
For Each Sht In Worksheets
Application.ScreenUpdating = False
Sht.Activate
With Application
.DisplayFullScreen = True '全屏显示属性是否为TRUE
.CommandBars(1).Enabled = False '隐藏工作表菜单栏
End With
With ActiveWindow
.DisplayGridlines = False '网格
.DisplayHeadings = False '行号列标
.DisplayOutline = False '分级显示符号
.DisplayHorizontalScrollBar = False '水平滚动条
.DisplayVerticalScrollBar = False '垂直滚动条
.DisplayWorkbookTabs = True '工作表标签
End With
Next
Application.ScreenUpdating = True
End Sub
相对应的,我要写出另外一个程序恢复界面的设置- 恢复界面。
简单来说,就是将之前设置为False的,变回True;之前是True的,现在是False。
Sub RestoreScreen()
'恢复界面
Application.ScreenUpdating = False
Dim Sht As Worksheet
For Each Sht In Worksheets
Sht.Activate
With Application
.DisplayFullScreen = False
.CommandBars(1).Enabled = True
End With
With ActiveWindow
.DisplayGridlines = True '网格线
.DisplayHeadings = True '行号列标
.DisplayOutline = True '分级显示符号
.DisplayHorizontalScrollBar = True '水平滚动条
.DisplayVerticalScrollBar = True '垂直滚动条
.DisplayWorkbookTabs = True '工作表标签
End With
Next
Application.ScreenUpdating = True
End Sub
通常可以直接点击已经创建两个按钮去触发程序,但这个需要两个按钮同时在场才能有效果。第一,能不能直接弄一个开关,控制着这两个程序?
第二,有什么方法,不用每到一个新的工作表,工作簿后要重新新建一个“按钮”呢?
针对第一种情况:定义一个布尔值,并默认为False,当第一次点击则会负负得正,返回True,进入简介界面模式。再点击一次,又会恢复回原来的Fasle,则返回并恢复原来界面。
Public Yuedu As Boolean
Private Declare Function MsgBoxTimeout Lib "User32" Alias "MessageBoxTimeoutA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long, ByVal wlange As VbMsgBoxStyle, ByVal dwTimeout As Long) As Long
Sub ReadingModel()
'***************************
'此函数的参数如下:
'hwnd:消息框拥有者窗口的句柄,可以设为 0
'lpText:消息框显示内容,类似于 MsgBox 函数的第一个参数 Prompt
'lpCaption:消息框标题,类似于 MsgBox 函数的第三个参数 Caption
'wType:消息框类型,类似于 MsgBox 函数的第二个参数 Buttons
'wlange:函数扩展,一般取 0
'dwTimeout:消息框延迟关闭时间,单位为毫秒
'返回的值和 vbMsgBoxResult 常数一样,多了一个返回值 32000 表示超过延时时间未选择任何按钮。
'***************************
UserName = Split(Environ("USERPROFILE"), "")(2)
Yuedu = Not Yuedu
If Yuedu = True Then
MsgBoxTimeout 0, UCase(UserName) & Space(1) & ",Weclome back,The reading model is coming", "[Tips]", vbInformation, 0, 2000 '一共演示2秒
SimplifiedScreen '简化界面
Else
RestoreScreen '恢复界面
MsgBoxTimeout 0, "The Normal View is back", "[Tips]", vbInformation, 0, 2000 '一共演示2秒
End If
End Sub
针对第二种情况,我们可以设置右键快捷菜单.
Sub Rightclickcom()
' add the right click botton to activate the process.
On Error Resume Next
Dim myBar As CommandBarButton
Application.CommandBars("CELL").Controls("Reading Model").Delete '右键快捷菜单
Set myBar = Application.CommandBars("CEll").Controls.Add(before:=1) '加在首位,第一个位置
With myBar
.Caption = "Reading Model" '名字
.Style = msoButtonIconAndCaption '按钮图标与文字的显示方式
.BeginGroup = True '是否需要分割线
.FaceId = 120
.OnAction = "ReadingModel" '要触发宏的程序名字(按键开关) '
End With
End Sub
自己既不想每次亲自动手创建和触发,而且希望类似功能自动生成。可以尝试将这个控制的总开关交给Application(Excel)。
亦即是,工作簿事件。这里可以用工作簿的打开事件,也可以用在点击右键之前的工作表事件:Worksheet_BeforeRightClick().
Private Sub Workbook_Open()
'打开工作簿夹即激活右键程序
Call Rightclickcom
End Sub