用Excel制作登录窗体

论坛 期权论坛 期权     
Excel之家ExcelHom   2019-6-16 19:15   3141   0
工作中有时需要对发出的Excel文件进行加密操作,避免文件中重要信息被不相关的人员获取。
提到Excel工作簿加密,小伙伴们可能马上会想到这样做:文件——>另存为——>工具——>常规选项——>设置打开密码。




那么,除了这种自带的工作簿加密方式,有没有更酷一些的操作呢?今天我给大家分享一个高级点的,设置用户窗体登录界面。效果如下:







怎么样,相对于自带的加密功能,是不是逼格立马高了许多。更重要的是,这个登录界面的背景图片和文字内容是可以自定义的。首次与用户交互便与众不同,让其有继续探索下去的兴趣。


请观看视频(第一次录制原声视频,哈哈^_^)

[iframe]https://mp.weixin.qq.com/mp/readtemplate?t=pages/video_player_tmpl&action=mpvideo&auto=0&vid=wxv_780211106236301314[/iframe]

制作步骤:
01

制作用户窗体基础界面


ALT+F11进入VBE编辑环境后,插入窗体,窗体背景图片,标签,文字框,命令按钮,并按要求命名。


02

为命令按钮赋宏

为宏按钮编写VBA代码,以下五段代码功能分别为:
  • 判断输入的用户名和密码是否正确;
  • 修改用户名;

  • 修改密码;

  • 禁止用户强制关闭登录窗体;

  • 退出用户窗体界面;

  1. Private Sub CmdOk_Click()          '单击"确定"按钮的时候执行过程
复制代码
  1.    'Application.ScreenUpdating = False          '关闭屏幕更新
复制代码
  1.     Static I As Integer                         '声明一个变量
复制代码
  1.    '判断用户名和密码是否输入正确
复制代码
  1.     If User.Value = Sheets("用户名密码").Range("A2") & "" And Password.Value = Sheets("用户名密码").Range("B2") & "" Then
复制代码
  1.         Unload Me                              '关闭登录窗体
复制代码
  1.         Application.Visible = True             '显示Excel界面
复制代码
  1.     Else
复制代码
  1.         I = I + 1             '密码或用户名输入错误一次,变量i加1
复制代码
  1.         If I = 3 Then         '如果输错三次执行下面的语句
复制代码
  1.             MsgBox "对不起,你无权打开工作薄!", vbInformation, "提示"
复制代码
  1.             ThisWorkbook.Close savechanges:=False            '关闭当前工作薄,不保存更改
复制代码
  1.         Else                        '如果输错不满三次,执行下面的语句
复制代码
  1.             MsgBox "输入错误,你还有" & (3 - I) & "次输入机会。", vbExclamation, "提示"
复制代码
  1.             User.Value = ""                 '清除文字框中的用户名
复制代码
  1.             Password.Value = ""             '清除文字框中的密码
复制代码
  1.         End If
复制代码
  1.     End If
复制代码
  1.     'Application.ScreenUpdating = True           '开启屏幕更新
复制代码
  1. End Sub
复制代码
  1. [/code][code]Private Sub UserSet_Click()          '单击修改用户名按钮时运行过程
复制代码
  1.     Dim old As String, new1 As String, new2 As String
复制代码
  1.     old = InputBox("请输入原用户名:", "提示")
复制代码
  1.     new1 = InputBox("请输入新用户名:", "提示:请在新用户名前后分别加上""英文双引号")
复制代码
  1.     new2 = InputBox("请再次输入新用户名:", "提示:请在新用户名前后分别加上""英文双引号")
复制代码
  1.     If old  "" And new1  "" Then                  '判断输入的用户名是否为空
复制代码
  1.         '判断新旧用户名是否输入正确
复制代码
  1.         If old = Sheets("用户名密码").Range("A2") And new1 = new2 Then
复制代码
  1.             Sheets("用户名密码").Range("A2") = new1
复制代码
  1.             ThisWorkbook.Save                        '保存更改
复制代码
  1.             MsgBox "用户名修改完成,下次登录请使用新用户名!", vbInformation, "提示"
复制代码
  1.         Else
复制代码
  1.             MsgBox "输入错误,修改没有完成!", vbCritical, "错误"
复制代码
  1.         End If
复制代码
  1.     Else
复制代码
  1.         MsgBox "用户名不能为空!", vbCritical, "错误"
复制代码
  1.     End If
复制代码
  1. End Sub
复制代码
  1. [/code][code]Private Sub PasswordSet_Click()    '当单击更改密码按钮时运行过程
复制代码
  1.     Dim old As String, new1 As String, new2 As String
复制代码
  1.     old = InputBox("请输入原密码:", "提示:请在新密码前后分别加上""英文双引号")
复制代码
  1.     new1 = InputBox("请输入新密码:", "提示:请在新密码前后分别加上""英文双引号")
复制代码
  1.     new2 = InputBox("请再次输入新密码:", "提示")
复制代码
  1.     If old  "" And new1  "" Then                 '
复制代码
  1. 判断输入的密码是否为空
复制代码
  1.         '判断新旧密码是否输入正确
复制代码
  1.         If old = Sheets("用户名密码").Range("B2") And new1 = new2 Then
复制代码
  1.             Sheets("用户名密码").Range("B2") = new1
复制代码
  1.             ThisWorkbook.Save        '保存更改
复制代码
  1.             MsgBox "密码修改完成,下次登录请使用新密码!", vbInformation, "提示"
复制代码
  1.         Else
复制代码
  1.             MsgBox "输入错误,修改没有完成!", vbCritical, "错误"
复制代码
  1.         End If
复制代码
  1.     Else
复制代码
  1.         MsgBox "密码不能为空!", vbCritical, "错误"
复制代码
  1.     End If
复制代码
  1. End Sub
复制代码
  1. [/code][code]Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
复制代码
  1. If CloseMode = vbFormControlMenu Then
复制代码
  1. MsgBox "请输入正确的用户名和密码登录"
复制代码
  1. Cancel = True
复制代码
  1. End If
复制代码
  1. End Sub
复制代码
  1. [/code][code]Private Sub CmdCancel_Click()    '当单击取消按钮时执行过程
复制代码
  1.     Unload Me    '关闭登录窗体
复制代码
  1.     ThisWorkbook.Close savechanges:=False  '关闭当前工作薄,不保存修改
复制代码
  1. End Sub
复制代码

03

设置工作表打开和关闭事件



这里主要用途是:
  • 打开工作簿时隐藏Excel界面只显示窗体界面;
  • 避免用户以特殊方式如Ctrl+Break或Esc、Command+Period等中断程序运行;
  • 在合法登录之前,将核心数据表深度隐藏;
最终目的是让用户登录窗体能切实发挥作用,避免形同虚设。
  1. Private Sub Workbook_Open()
复制代码
  1. Application.ScreenUpdating = False '暂停刷新屏幕
复制代码
  1. '屏蔽用户以Ctrl+Break(或 Esc、Command+Period)方式中断程序
复制代码
  1. Application.EnableCancelKey = xlDisabled
复制代码
  1. Application.Visible = False
复制代码
  1. UserForm1.Show
复制代码
  1. Dim sh As Worksheet
复制代码
  1.     For Each sh In Worksheets
复制代码
  1.         sh.Visible = xlSheetVisible
复制代码
  1.     Next
复制代码
  1. Sheets("数据地图").Select
复制代码
  1. Application.ScreenUpdating = True '恢复刷新屏幕
复制代码
  1. End Sub
复制代码
  1. [/code][code]Private Sub Workbook_BeforeClose(Cancel As Boolean)
复制代码
  1. Dim sh As Worksheet
复制代码
  1.     For Each sh In Worksheets
复制代码
  1.         If sh.Name  "首页" Then
复制代码
  1.             sh.Visible = xlSheetVeryHidden
复制代码
  1.         Else
复制代码
  1.             sh.Visible = xlSheetVisible
复制代码
  1.         End If
复制代码
  1.     Next  
复制代码
  1. End Sub
复制代码
注:
1.因工作簿中至少要求保留一个工作表,无法全部隐藏,所以这里单独设置了”首页“工作表。本工作表无实质内容,只是简单的操作指导手册以及数据来源和作者信息等。当弹出询问“是否启用宏”的对话框时可显示该界面;


2.为了更好地保护用户名和密码,可以借助设置单元格格式为自定义的三个英文分号";;;"将用户名和密码隐藏,并配合工作表保护使用;






3.可以为VBA代码设置工程密码(本例密码123),以保护全部代码。





至此,大功告成!


即便如此,用此方法制作的登录窗体,其实并非绝对安全可靠。毕竟连Windows和Office都可以盗版,何况用excel开发的登录界面。但是,日常工作中用这样的方式呈现,还是可以让人耳目一新、印象深刻。

图文制作:爱上深呼吸李强
原载公众号:Excel知识管理


点击图标进入ExcelHome云课堂,发现更多精彩课程
[url=][/url]
专业的职场技能充电站
分享到 :
0 人收藏
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

积分:800
帖子:160
精华:0
期权论坛 期权论坛
发布
内容

下载期权论坛手机APP