Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2327|回复: 8

[已解决]excel如何加密保護?

[复制链接]
发表于 2015-12-18 09:21 | 显示全部楼层 |阅读模式
excel2007……想要對excel實現密保
使用兩個按鈕,一個是“加密”,一個“解密”,“加密”按鈕默認使用密碼123456,點擊"加密"按鈕無需再輸入密碼;excel加密後,點擊“解密”按鈕,出現輸入框提示“請輸入密碼” 確認/取消,如果輸入密碼是123456,確認;則excel解密,否則提示“密碼錯誤,請重新輸入密碼” 確認/取消
使用VB程序如何實現以上所述?請各位大神賜教,感激不盡~~!!
以下是瞎琢磨的程序:
加密:
Private Sub CommandButton6_Click()
    Sheets("cost").Select
    Selection.EntireColumn.Hidden = False
    Range("C:D,F:G,I:J,L:M,O:P,R:S,U:V,X:Y,AA:AB,AD:AE").Select
    Selection.EntireColumn.Hidden = True
    Sheets("plastics").Visible = False
    Sheets("metals").Visible = False
    Sheets("cost").Select
    ActiveSheet.Protect 123456
End Sub

解密:
Private Sub CommandButton7_Click()
    ActiveSheet.Unprotect
    Range("C:D,F:G,I:J,L:M,O:P,R:S,U:V,X:Y,AA:AB,AD:AE").Select
    Selection.EntireColumn.Hidden = False
    Sheets("plastics").Visible = True
    Sheets("metals").Visible = True
    Sheets("cost").Select
End Sub

效果圖:

加密

加密

解密

解密

解密密碼錯誤

解密密碼錯誤


以上請各位大神指正,3Q!!


最佳答案
2015-12-18 11:42
Const MyPassWord = "123456"

Private Sub CommandButton1_Click()
    Sheet1.Unprotect MyPassWord
    Call setOff
    Sheet1.Protect MyPassWord
End Sub

Private Sub CommandButton2_Click()
    Dim msg As String
    msg = InputBox("块?盞絏", "盞絏块??")
    If Len(msg) = 0 Then Exit Sub
    If msg = MyPassWord Then
        Sheet1.Unprotect MyPassWord
        Call setOn
    Else
        MsgBox "盞絏岿粇"
    End If
End Sub

Sub setOff()
    Sheet1.Range("C:D,F:G,I:J,L:M,O:P,R:S,U:V,X:Y,AA:AB,AD:AE").EntireColumn.Hidden = True
    Sheet2.Visible = False
    Sheet3.Visible = False
End Sub

Sub setOn()
    Sheet1.Range("C:D,F:G,I:J,L:M,O:P,R:S,U:V,X:Y,AA:AB,AD:AE").EntireColumn.Hidden = False
    Sheet2.Visible = True
    Sheet3.Visible = True
End Sub
excel-sample2.rar (20.49 KB, 下载次数: 27)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2015-12-18 10:01 | 显示全部楼层
你这个没有用,
百度上复制个破解工作表保护的VBA,运行下就破解了
回复

使用道具 举报

发表于 2015-12-18 10:01 | 显示全部楼层
代码中的sheet1 为要加或解密码的工作表

  1. Sub myProtect()
  2.   Sheet1.Protect "123456"
  3. End Sub

  4. Sub myUnprotect()
  5. Dim myPassword As String
  6.   myPassword = InputBox("输入密码", "密码输入框")
  7.   If Len(myPassword) = 0 Then Exit Sub
  8.   If myPassword = "123456" Then
  9.     Sheet1.Unprotect myPassword
  10.   Else
  11.     MsgBox "密码错误"
  12.   End If
  13. End Sub

复制代码
需要注意的是,如果用户解密后,修改了密码这过程就悲剧了
回复

使用道具 举报

 楼主| 发表于 2015-12-18 10:10 | 显示全部楼层
kaio 发表于 2015-12-18 10:01
你这个没有用,
百度上复制个破解工作表保护的VBA,运行下就破解了

沒事,這只是隨便加密,目的是不能隨便不小心修改,有解嗎??
回复

使用道具 举报

 楼主| 发表于 2015-12-18 10:57 | 显示全部楼层
know 发表于 2015-12-18 10:01
代码中的sheet1 为要加或解密码的工作表需要注意的是,如果用户解密后,修改了密码这过程就悲剧了

非常感謝,已經初步解決問題,但還有一些小瑕疵:
因為我的主要目的是隱藏一些表格後加密;解密後自動顯示隱藏的表格,下面兩段程序,有些問題,望再幫忙更正一下,以達到目的:
1. 加密後再點擊“加密”按鈕會無反應,或提示“文件已加密”
2. 解密後密碼錯誤點確定不要報錯,可結束或提示“重新輸入密碼”
謝謝!(以下是兩段錯誤程序)
Private Sub CommandButton1_Click()
    Sheet1.Select
    Selection.EntireColumn.Hidden = False
    Range("C:D,F:G,I:J,L:M,O:P,R:S,U:V,X:Y,AA:AB,AD:AE").Select
    Selection.EntireColumn.Hidden = True
    Sheet2.Visible = False
    Sheet3.Visible = False
    Sheet1.Select
    Sheet1.Protect "123456"
End Sub

Private Sub CommandButton2_Click()
Dim myPassword As String
  myPassword = InputBox("輸入密碼, "密碼輸入框")
  If Len(myPassword) = 0 Then Exit Sub
  If myPassword = "123456" Then
    Sheet1.Unprotect myPassword
  Else
    MsgBox "密碼錯誤"
  End If
     Range("C:D,F:G,I:J,L:M,O:P,R:S,U:V,X:Y,AA:AB,AD:AE").Select
    Selection.EntireColumn.Hidden = False
    Sheet2.Visible = True
    Sheet3.Visible = True
    Sheet1.Select
End Sub

0004.jpg 0005.jpg

以上望指教,謝謝!!

回复

使用道具 举报

发表于 2015-12-18 11:03 | 显示全部楼层
建议上传excel。
大多数时候,需先查看附件,有没有什么特别情况。
回复

使用道具 举报

 楼主| 发表于 2015-12-18 11:23 | 显示全部楼层
爱疯 发表于 2015-12-18 11:03
建议上传excel。
大多数时候,需先查看附件,有没有什么特别情况。

謝謝!
excel見附件,請幫忙修改一下,謝謝!
excel-sample.rar (19.96 KB, 下载次数: 6)
回复

使用道具 举报

发表于 2015-12-18 11:42 | 显示全部楼层    本楼为最佳答案   
Const MyPassWord = "123456"

Private Sub CommandButton1_Click()
    Sheet1.Unprotect MyPassWord
    Call setOff
    Sheet1.Protect MyPassWord
End Sub

Private Sub CommandButton2_Click()
    Dim msg As String
    msg = InputBox("块?盞絏", "盞絏块??")
    If Len(msg) = 0 Then Exit Sub
    If msg = MyPassWord Then
        Sheet1.Unprotect MyPassWord
        Call setOn
    Else
        MsgBox "盞絏岿粇"
    End If
End Sub

Sub setOff()
    Sheet1.Range("C:D,F:G,I:J,L:M,O:P,R:S,U:V,X:Y,AA:AB,AD:AE").EntireColumn.Hidden = True
    Sheet2.Visible = False
    Sheet3.Visible = False
End Sub

Sub setOn()
    Sheet1.Range("C:D,F:G,I:J,L:M,O:P,R:S,U:V,X:Y,AA:AB,AD:AE").EntireColumn.Hidden = False
    Sheet2.Visible = True
    Sheet3.Visible = True
End Sub
excel-sample2.rar (20.49 KB, 下载次数: 27)
回复

使用道具 举报

 楼主| 发表于 2015-12-18 12:09 | 显示全部楼层
爱疯 发表于 2015-12-18 11:42
Const MyPassWord = "123456"

Private Sub CommandButton1_Click()

非常感謝!!!已解決~~
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 17:01 , Processed in 0.693327 second(s), 12 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表