EXCEL如何强制用户在工作簿中启用宏?
haoteby 2024-12-03 15:17 16 浏览
有朋友问:如果用户工作簿禁用了宏,怎样对特定工作表进行隐藏,让用户无法查看?只有当宏被打开时显示其他工作表?
下表是当用户禁用工作簿宏时,隐藏其他工作表的同时显示提示:
要实现这样的功能,我们可以通过实现Workbook_Open、Workbook_BeforeClose、Workbook_BeforeSave等事件处理程序,我们可以控制工作簿在打开、关闭和保存时的行为。例如,在打开工作簿时自动显示所有工作表,并在关闭前检查是否需要保存更改;通过拦截标准的保存操作,我们可以调用自定义的保存函数CustomSave,该函数允许用户选择保存位置、格式,并在保存前隐藏所有非警告工作表,以避免不必要的干扰或数据泄露。同时,将介绍如何编写HideAllSheets和ShowAllSheets子程序来智能管理工作表的可见性。这些子程序将帮助用户隐藏除警告工作表外的所有工作表,并在需要时重新显示它们,从而保护敏感数据或简化工作簿的视图。代码片段如下:
' 强制显式声明变量
Option Explicit
' 将警告工作表的名称分配给一个常量
Const Warning As String = "提示"
' 工作簿打开时自动执行的宏
Private Sub Workbook_Open()
' 关闭屏幕更新
Application.ScreenUpdating = False
' 调用显示所有工作表的例程
Call ShowAllSheets
' 将工作簿的已保存属性设置为True
Me.Saved = True
' 打开屏幕更新
Application.ScreenUpdating = True
End Sub
' 工作簿关闭前执行的宏
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' 声明变量
Dim Ans As Integer
' 如果工作簿的已保存属性为False,则模拟Excel的默认保存提示
If Me.Saved = False Then
Do
Ans = MsgBox("你想保存对 '" & Me.Name & "' 的更改吗?", vbQuestion + vbYesNoCancel)
Select Case Ans
Case vbYes
' 调用自定义保存例程
Call CustomSave
Case vbNo
Me.Saved = True
Case vbCancel
Cancel = True
Exit Sub
End Select
Loop Until Me.Saved
End If
End Sub
' 工作簿保存前执行的宏
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' 取消常规保存
Cancel = True
' 调用自定义保存例程
Call CustomSave(SaveAsUI)
End Sub
' 自定义保存例程
Private Sub CustomSave(Optional SaveAs As Boolean)
' 声明变量
Dim ActiveSht As Object
Dim FileFormat As Variant
Dim FileName As String
Dim FileFilter As String
Dim FilterIndex As Integer
Dim Msg As String
Dim Ans As Integer
Dim OrigSaved As Boolean
Dim WorkbookSaved As Boolean
' 关闭屏幕更新
Application.ScreenUpdating = False
' 关闭事件,防止在保存时再次触发BeforeSave事件
Application.EnableEvents = False
' 将工作簿的已保存属性保存到变量
OrigSaved = Me.Saved
' 获取当前活动的工作表
Set ActiveSht = ActiveSheet
' 调用隐藏所有工作表(除了提示工作表)的例程
Call HideAllSheets
' 根据是否需要另存为或路径为空,处理保存逻辑
' ...(此处省略了部分逻辑以保持注释简洁)
'...
' 调用显示所有工作表的例程
Call ShowAllSheets
' 激活之前的活动工作表
ActiveSht.Activate
' 根据是否成功保存,更新工作簿的已保存属性
If WorkbookSaved Then
Me.Saved = True
Else
Me.Saved = OrigSaved
End If
' 打开屏幕更新
Application.ScreenUpdating = True
' 打开事件
Application.EnableEvents = True
End Sub
Private Sub HideAllSheets()
Dim Sh As Object
Sheets("提示").Visible = xlSheetVisible
For Each Sh In Sheets
If Sh.Name <> Warning Then
Sh.Visible = xlSheetVeryHidden
End If
Next Sh
End Sub
Private Sub ShowAllSheets()
Dim Sh As Object
For Each Sh In Sheets
If Sh.Name <> Warning Then
Sh.Visible = xlSheetVisible
End If
Next Sh
Sheets("提示").Visible = xlSheetVeryHidden
End Sub
Private Function IsLegalFilename(ByVal fname As String) As Boolean
Dim BadChars As Variant
Dim i As Long
If Len(fname) > 218 Then
IsLegalFilename = False
Exit Function
Else
BadChars = Array("\", "/", "<", ">", "?", "[", "]", ":", "|", "*", """")
fname = GetFileName(fname)
For i = LBound(BadChars) To UBound(BadChars)
If InStr(1, fname, BadChars(i)) > 0 Then
IsLegalFilename = False
Exit Function
End If
Next i
End If
IsLegalFilename = True
End Function
Private Function GetFileName(ByVal FullName As String) As String
Dim i As Long
For i = Len(FullName) To 1 Step -1
If Mid(FullName, i, 1) = Application.PathSeparator Then Exit For
Next i
GetFileName = Mid(FullName, i + 1)
End Function
通过本篇文章,读者将学习到如何通过VBA编程来扩展Excel的功能,使其更加符合个人或团队的特定需求。
相关推荐
- Chrome OS 41 用 Freon 取代 X11_chrome os atom
-
在刚发布的ChromeOS41里,除了常规的Wi-Fi稳定性提升(几乎所有系统的changelog里都会包含这一项)、访客模式壁纸等之外,还存在底层改变。这一更新中Google移除...
- 苹果iPad Pro再曝光 有望今年六月发布
-
自进入2015年以后,有关大屏iPad的消息便一直不绝于耳,之前就有不少媒体猜想这款全新的平板电脑将会在三月发布,不过可惜的是我么只在那次发布会上看到了MacBookPro。近日@Ubuntu团队便...
- 雷卯针对香橙派Orange Pi 5 Max开发板防雷防静电方案
-
一、应用场景高端平板、边缘计算、人工智能、云计算、AR/VR、智能安防、智能家居、Linux桌面计算机、Linux网络服务器、Android平板、Android游戏机...
- Ubuntu Server无法更新问题解决_ubuntu server not found
-
上周老家的一台运行UbuntuServer的盒子无法连接上了,中秋这两天回来打开,顺手更新一下发现更新报错。提示`E:Releasefileforhttps://mirrors.aliyun...
- 虚幻引擎5正式版发布:古墓丽影&巫师新作采用、新一代实时渲染
-
机器之心报道编辑:杜伟、陈萍虚幻引擎5的目标是「助力各种规模的团队在视觉领域和互动领域挑战极限,施展无限潜能」。...
- AMD Milan-X双路霄龙7773X平台基准测试曝光 CPU缓存总量超1.5GB
-
OpenBenchmarking基准测试数据库刚刚曝光了AMDMilan-X双路霄龙7773X平台的跑分成绩,虽然很快就被撤下,但我们还是知晓了高达1.6GB的总CPU缓存。早些时...
- 全网最新的Dify(1.7.2)私有化离线部署教程(ARM架构)
-
Hello,大家好!近期工作中有涉及到Dify私有化离线部署,特别是针对于一些国产设备。因此特别整理了该教程,实测有效!有需要的小伙伴可以参考下!本文主要针对Dify1.7.2最新版本+国产操作系...
- 在ubuntu下新建asp.net core项目_创建ubuntu
-
本文一步步讲述在ubuntu下用visualstudiocode创建asp.netcore项目的过程。step1:环境操作系统:virtualbox下安装的lubuntu。请不要开启“硬件...
-
- 在晶晨A311D2处理器上进行Linux硬件视频编码
-
在KhadasVIM4AmogicA311D2SBC上,我更多的时间是在使用Ubuntu22.04。它的总体性能还不错,只不过缺少3D图形加速和硬件视...
-
2025-08-26 17:22 haoteby
- Nacos3.0重磅来袭!全面拥抱AI,单机及集群模式安装详细教程!
-
之前和大家分享过JDK17的多版本管理及详细安装过程,然后在项目升级完jdk17后又发现之前的注册和配置中心nacos又用不了,原因是之前的nacos1.3版本的,版本太老了,已经无法适配当前新的JD...
- 电影质量级渲染来了!虚幻引擎5.3正式发布:已开放下载
-
快科技9月8日消息,日前,Unrealengine正式发布了虚幻引擎5.3,带来了大量全方位的改进。...
- 2025如何选购办公电脑?极摩客mini主机英特尔系列选购指南
-
当下,迷你主机的性能越来越强,品类也越来越多。但是CPU是不变的,基本都是AMD和英特尔的。有一个小伙伴在评论区提问,我应该如何在众多机器中选购一台符合自己的迷你主机呢?那今天我们优先把我们的系列,分...
- ubuntu 20.04+RTX4060 Ti+CUDA 11.7+cudnn
-
ububtu添加国内源sudocp/etc/apt/sources.list/etc/apt/sources.list.backupsudovim/etc/apt/sources.lis...
- Linux Mint 18将重新基于Ubuntu 16.04 带来更好硬件支持
-
项目负责人ClementLefebvre在本月6日披露了关于LinuxMint18“Sarah”操作系统的大量信息,包括带来全新扁平化体验的Mint-Y主题。而现在,这款将于年底之前上线的操作...