更新日志

   日期       |         内容
------------ | ---------------------------------
2020-05-17   |  1、更改“只读”默认为“否”|  2、提供消息提示，操作更直观|  3、活动单元格离开本行，自动切换“只读” |  4、添加部分单元格注释

代码

ThisWorkbook

Option ExplicitPrivate Sub Workbook_BeforeClose(Cancel As Boolean)Application.EnableEvents = False' 清除日志Range("logs").Value = ""Application.EnableEvents = True
End SubPrivate Sub Workbook_Open()' 工作簿打开事件'意思为 对菜单中 “工具-选项-安全性-保存时从文件属性中删除个人信息” 的取消勾选。ThisWorkbook.RemovePersonalInformation = False' 禁用 DeleteApplication.OnKey "{DEL}", ""Application.OnKey "{DELETE}", ""' 清除超链接Sheet1.Hyperlinks.DeleteSheet1.Cells(1, 1).Select
End Sub

Sheet1

Option ExplicitPublic oldRow As Integer      ' 旧的行号，实现离开该行自动切换只读Private Sub Worksheet_SelectionChange(ByVal Target As Range)' 离开本行自动切换为只读On Error GoTo eApplication.EnableEvents = FalseDim Row As Integer, Col As IntegerRow = Target.RowCol = Target.Column'MsgBox "new:" & Row & "  old:" & oldRowIf Col = 1 Or (Row <> oldRow And Target.Row > 4) ThenIf Range("K" & oldRow).Value = "False" ThenRange("K" & oldRow).Value = "True"End IfEnd If' 刷新旧行oldRow = Row' 清除日志Range("logs").Value = ""Application.EnableEvents = TrueExit Sub
e:Select Case OnErrorsCase 0ResumeCase 1Resume NextCase 2End Select
End SubPrivate Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)Cancel = True
End SubPrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)' 单元格双击事件On Error GoTo e' 关闭事件处理Application.EnableEvents = FalseDim Row As Integer, Col As Integer, result As Integer, i As Integer, readNoly As Boolean' 行号Row = Target.Row' 列号Col = Target.ColumnSelect Case Target.Name.Name' 排除默认值区域Case "default_alias", "default_username", "default_phone_number", "default_mail", "default_first_name", "default_last_name"Application.EnableEvents = TrueExit SubEnd Select' 是否只读If Range("K" & Row).Value = "False" ThenreadNoly = FalseElsereadNoly = TrueEnd IfIf Row > 4 And (Col >= 2 And Col <= 9 And readNoly) And Cells(Row, Col) <> "" Then' 只读时复制到剪切板Call copy_to_clipboardElseIf Col >= 2 And Col <= 9 And Not readNoly Then' 允许编辑单元格Application.EnableEvents = TrueExit SubElseIf Col = 1 Then' 以默认配置创建新行If Row = oldRow Then' 切换只读If Range("K" & Row).Value = "False" ThenRange("K" & Row).Value = "True"End IfEnd IfFor i = 5 To 180If Range("A" & i).Value = "" Thencreate_new_row (i)Exit ForEnd IfNextElseIf Col = 11 Then' 切换只读状态If Target.Value = "True" Thenresult = MsgBox("确定取消“只读”吗？", vbOKCancel + vbQuestion, "来自 one-ccs 的提示")If result = vbOK ThenTarget.Value = "False"End IfElseIf Target.Value = "False" ThenTarget.Value = "True"End IfElseIf Col = 12 And Row > 4 And Cells(Row, Col - 1) <> "" Then' 清空行result = MsgBox("确定“清空”本行吗？该操作无法恢复！！", vbOKCancel + vbExclamation, "来自 one-ccs 的警告")If result = vbOK Then' Application.EnableEvents = FalseRange("A" & Row & ":L" & Row).ClearContentsRange("logs").Value = "[ " & Now() & " ] 清空行（" & Row & "）"' Application.EnableEvents = TrueEnd IfEnd If' 开启事件处理Application.EnableEvents = True' Cancel 值为 True 时表示事件已被处理，将不再交换给系统（双击事件是进入编辑模式）' 所有事件的Cancel参数,都用来取消该事件的下一步执行,就BeforeDoubleClick事件来说,正常情况下,将使Target 单元格进入编辑状态,如果在事件中指定Cancel参数为True,将禁止单元格进入编辑状态.Cancel = TrueExit Sub
e:Select Case OnErrorsCase 0ResumeCase 1Resume NextCase 2End Select
End SubPrivate Sub Worksheet_Change(ByVal Target As Range)' 实现只读效果On Error GoTo eApplication.EnableEvents = FalseDim Row As Integer, Col As Integer, result As Integer, readNoly As Boolean' 行号Row = Target.Row' 列号Col = Target.Column' 是否只读If Range("K" & Row).Value = "False" ThenreadNoly = FalseElsereadNoly = TrueEnd IfSelect Case Target.Name.Name' 排除默认值区域Case "default_alias", "default_username", "default_phone_number", "default_mail", "default_first_name", "default_last_name"Application.EnableEvents = TrueExit SubEnd SelectIf Row <= 4 Or Col > 9 Or (Col >= 1 And Col <= 12 And readNoly) Thenresult = MsgBox("该单元格不可编辑!", vbOKOnly + vbExclamation, "来自 one-ccs 的警告")Application.UndoEnd IfApplication.EnableEvents = TrueExit Sub
e:Select Case OnErrorsCase 0ResumeCase 1Resume NextCase 2End Select
End SubPrivate Function create_new_row(ByVal Row As Integer)' 在行号 Row 生成默认配置On Error GoTo eRange("A" & Row).Value = Row - 4Range("B" & Row).Value = "*"Range("C" & Row).Value = Range("default_alias").ValueRange("D" & Row).Value = Range("default_username").ValueRange("E" & Row).Value = get_password()Range("F" & Row).Value = Range("default_phone_number").ValueRange("G" & Row).Value = Range("default_mail").ValueRange("H" & Row).Value = Range("default_first_name").ValueRange("I" & Row).Value = Range("default_last_name").ValueRange("J" & Row).Value = Now()Range("K" & Row).Value = "False"Range("L" & Row).Value = "X"oldRow = RowCells(Row, 1).SelectExit Function
e:Select Case OnErrorsCase 0ResumeCase 1Resume NextCase 2End Select
End FunctionPrivate Function copy_to_clipboard()' 复制到剪切板Dim str As Stringstr = ActiveCell.ValueWith CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}").SetText str.PutInClipboardEnd WithRange("logs").Value = "[ " & Now() & " ] 复制成功（" & str & "）"End FunctionPrivate Function get_password() As StringDim password As Stringpassword = Chr(Int(Rnd() * 26 + 65)) & _Int(Rnd() * 9 + 1) & _Chr(Int(Application.RandBetween(33, 47))) & _Chr(Int(Rnd() * 26 + 65)) & _Chr(Int(Rnd() * 26 + 65)) & _Int(Rnd() * 9 + 1) & _Chr(Int(Application.RandBetween(33, 47))) & _Chr(Int(Rnd() * 26 + 97)) & _Int(Rnd() * 900 + 100) & _Chr(Int(Rnd() * 26 + 97)) & _Int(Rnd() * 9 + 1) & _Chr(Int(Application.RandBetween(33, 47))) & _Chr(Int(Rnd() * 26 + 65))get_password = password
End FunctionPrivate Function OnErrors() As Integer' 错误处理函数Dim info As Stringinfo = "[ " & Now() & " ] 程序遇到错误！" & _"错误码：" & err.Number & _"；错误信息：" & err.DescriptionSelect Case err.NumberCase -2147221040OnErrors = 1Case 438OnErrors = 1Case 1004' Range("logs").Value = infoOnErrors = 1Case ElseRange("logs").Value = info & "处理方式：跳过错误"' 跳过错误继续执行OnErrors = 1End Select
End Function

【VBA】Excel 密码管理器相关推荐

SSIS 错误代码 DTS_E_OLEDB_EXCEL_NOT_SUPPORTED 没有可用的 OLE DB 访问接口 SSIS 的 64 位版本中不支持 Excel 连接管理器...
在Server 2008 R2的系统中,使用SQL安装包的BIDS(vs 08 shell)开发SSIS,按例子建好一个后,提示" SSIS 错误代码 DTS_E_OLEDB_EXCEL_N ...
Firefox 密码管理器 Lockbox 推出 Android 版
开发四年只会写业务代码,分布式高并发都不会还做程序员? Mozilla 今日在 Android 上推出了一项新功能"Firefox Lockbox",该功能此前已经出现在桌面( ...
幕后产品_使用Bitwarden密码管理器在幕后
幕后产品我们是人类. 我们每天都被技术和帐户所淹没,大多数人会选择一个容易记住的密码. -乔纳森·勒布朗(Jonathan LeBlanc),前PayPal 必须记住Web应用程序,电子邮件,银行帐 ...
使用Python编写自己的个人密码管理器
技术要点: 1)tkinter界面设计: 2)SQLite数据库操作: 3)字符串异或运算加密和解密. 使用方法: 只需要记住一个加解密密钥即可,对于各平台的密码,使用密钥加密后存储到数据库,查询时使 ...
神秘黑客攻陷密码管理器 Passwordstate 部署恶意软件，发动软件供应链攻击
聚焦源代码安全,网罗国内外最新资讯! 专栏·供应链安全数字化时代,软件无处不在.软件如同社会中的"虚拟人",已经成为支撑社会正常运转的最基本元素之一,软件的安全性问题也正在成为 ...
这五款热门商用密码管理器中均存在缺陷，可导致用户凭证被盗
聚焦源代码安全,网罗国内外最新资讯! 编译:奇安信代码卫士团队英国约克大学的研究员 Michael Carr 和 Siamak F. Shahandashti从五款热门商用密码管理器 LastPa ...
keepass+onedrive打造密码管理器
problem 如题,密码经常会忘记,所以需要密码管理器. 满足以下特点: 在线同步:Android,iOS,Windows,macOS,Chrome 离线查看:数据是否在自己手中软件收费:1pas ...
unity3d发布linux版本_密码管理器 1Password 发布第一个 Linux 测试版本
1Password 是知名的跨平台密码管理器工具,刚刚发布了第一个 Linux 测试版本,拥有创建.搜索建议.共享.剪贴板清理.快捷键等功能.@Appinn 虽然青小蛙不是 Linux 桌面用户,但为 ...
密码管理器（PM）安全机制和问题研究
密码管理器(PM)安全机制和问题研究 1 研究背景随着身份认证技术的发展,除了传统的用户名/密码认证之外,动态口令认证.智能卡认证.生物特征认证也逐渐在该领域中占领一席之地,但仍然存在一些安全性问题 ...
c语言实现一个密码管理器（更新中）
作为电脑爱好者,会经常注册各种网站的账号,但是考虑到隐私的可能泄露,不喜欢把密码托管给浏览器,于是经常忘记各种密码.饱受折磨后,我决定用学的一点点c语言知识写一个密码管理器. 在写之前我希望它目前可以 ...

【VBA】Excel 密码管理器

更新日志

代码

【VBA】Excel 密码管理器相关推荐

最新文章

热门文章