小程序隐藏滚动条_【VBA综合小案例】简化界面

9398b1ef79bb69961a0fba57b8574d76.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

原版还没有使用之前:

511fdd93a776e44144308884233f4c72.png


以下是简化界面的代码:

 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
  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值