このマクロは Microsoft Excel 97 で作成されています。Excel 2000でも使用できます。
■使用目的
Microsoft Excelの機能にある、[シートの保護]にパスワードロックがかかっていて開けない場合に、
パスワードを割り出し、ロックを解除する。
■利用規約
・悪用しないで下さい。
・ご利用するにあたってのトラブルに対して作者はいかなる責任も負いません。
以上の規約を守れる方のみ使用して下さい。
■パスワードについて
1:Excel 97で使用できる日本語のパスワードが設定されている場合は解除できません。
2:パスワードの解析に成功したらパスワードが表示されますが、
入力したパスワードではない文字でもロックが外れる場合がある。
3:パスワードの長さが長いほど解除に時間がかかります。
4:プログラム中のStrKeyの値を少なくすることで処理時間が早くなります。
■使用方法
1:パスワードで保護されているExcelのシートを開きます。
2:以下のモジュールをコピーし、開いたExcelのマクロに貼り付けます。
3:パスワードで保護されているシートをアクティブ状態にします。
4:マクロを実行します。
| 0001 0002 0003 0004 0005 0006 0007 0008 0009 0010 0011 0012 0013 0014 0015 0016 0017 0018 0019 0020 0021 0022 0023 0024 0025 0026 0027 0028 0029 0030 0031 0032 0033 0034 0035 0036 0037 0038 0039 0040 0041 0042 0043 0044 0045 0046 0047 0048 0049 0050 0051 0052 0053 0054 0055 0056 0057 0058 0059 0060 0061 0062 |
'------------------------------------------------------------------------------ ' アクティブシートをパスワード付きの保護から解除する '------------------------------------------------------------------------------ Sub UnLock1() On Error Resume Next Dim str1 As String Dim str2() As String '検索用文字列配列 Dim strKey As String '検索用文字列一覧 Dim i1 As Integer 'ループカウンタ1 Dim i2 As Integer 'ループカウンタ2 Dim i3 As Integer 'ループカウンタ3 Dim i4 As Integer 'ループカウンタ4 Dim i5 As Integer 'ループカウンタ5 Dim pwd As String 'パスワード If MsgBox("アクティブシートのパスワードロックを解除します。実行しますか？" & _ vbCrLf & vbCrLf & _ "途中で中止したい場合は Ctrl + Break キーを押してください。", _ vbYesNo + vbQuestion) = vbNo Then Exit Sub '確認メッセージ strKey = ",1,2,3,4,5,6,7,8,9,0" '空白&数字（10） strKey = strKey & ",a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z" '英字小 （26） strKey = strKey & ",A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z" '英字大 （26） strKey = strKey & ", ,!,@,#,$,%,^,&,*,(,),+,=" '記号 （13） strKey = strKey & ",-,_,/,.,?,>,<,:,;,[,],\,~,|,{,},`" '記号 （17） str2 = Split(strKey, ",") '1文字ずつに分ける ReDim Preserve str2(UBound(str2) + 1) '配列を１つ追加 str2(UBound(str2)) = "," '追加した配列に","を入れる For i1 = LBound(str2) To UBound(str2) '1文字目のループ For i2 = LBound(str2) To UBound(str2) '2文字目のループ For i3 = LBound(str2) To UBound(str2) '3文字目のループ For i4 = LBound(str2) To UBound(str2) '4文字目のループ For i5 = LBound(str2) To UBound(str2) '5文字目のループ pwd = str2(i1) & str2(i2) & str2(i3) & str2(i4) & str2(i5) '↓を表示すると現在の値がイミディエイトウィンドウに '表示されます。ただし処理速度が格段に落ちます。 'Debug.Print pwd ActiveSheet.Unprotect pwd 'アクティブシートのロック解除を試みる Select Case Err.Number Case 0 'パスワードが正しい場合 MsgBox "パスワードが解けました。" & vbCrLf & vbCrLf & _ "Password=" & pwd, vbInformation Exit Sub Case 1004 'パスワードが間違っていた場合 Err.Number = 0 Err.Clear Case Else '1004以外のエラーが発生した場合 MsgBox "1004以外のエラーが発生しました。" & vbCrLf & vbCrLf & _ "ErrorNumber=" & Err.Number & vbCrLf & Err.Description, vbExclamation Exit Sub End Select Next Next Next Next Next '※Excel2000では２バイト文字をパスワードに使用することはできません。97では使用可能でした。 MsgBox "パスワードは残念ながら見つかりませんでした。" & vbCrLf & _ "２バイト文字で設定されているか、文字数が予想よりも長いことなどが考えられます｡ ", vbExclamation End Sub |