【VBA综合小案例】简化界面

3 年前 · 来自专栏 Excel 学习笔记

Simon Gan

这是我平常总结工作的时候，会运用到一些VBA知识解决的小案例。
通常，我们接收到一些工作表，表格界面没有一定程序的简化，比方说：网络线没有删除，横纵坐标（1-N;A-ZZ..），垂直水平滚动条没有隐藏等等。

本章总结了以下的 知识点 ：
1# Application 对象（Excel界面）上的用法
2# ActiveWindow 属性，同样对Excel界面进行操作
3# 自定义（鼠标）右击的快捷菜单
4# 功能的开关设置
5# API 函数定时的消息框MessageboxtimeoutA
6# 工作簿事件（Open）/ 工作表事件（BeforeRightClick）
7# Environ("userprofile") / Environ("username") 返回机主缩写名称

使用简化界面功能，如下图：

原版还没有使用之前：

以下是简化界面的代码：

 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
    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
    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      '简化界面
      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