| |
こんばんわ。
ブックを開く時に最初にフォームでパスワード入力画面として
正しいパスワードを入力した場合のみ開くようにしたいのですが、
いろいろ試してもうまく作動しません
パスワード付保存→済
ブックを開こうとすると
1.保護されていますのメッセージ&パス入力画面
↓(パス入力)
2.上書き保存するにはパスが必要ですのメッセージ&パス入力画面
↓(パス入力)
3.フォーム入力画面
↓(パス入力)
4.上記でパス入力キャンセルしても開いてしまう。
これをまず、最初にフォーム入力からに変更したいのと
どうもうまくフォームでのパスチェックが出来ていないようなのです。
記述してあるマクロ
1)This Workbook内
'==============================================================
Const パスワード = "11111111" '
Sub パスワード付保存()
Dim retcode As Long
retcode = save_bk(Workbooks("test.xls"), "c:\test.xls", パスワード)
If retcode <> 0 Then
MsgBox Error(retcode)
Else
MsgBox "保存されました"
End If
End Sub
'==============================================================
Function save_bk(bk As Workbook, bk_path, Optional password = "") As Long
On Error Resume Next
save_bk = 0
Application.DisplayAlerts = False
bk.SaveAs Filename:=bk_path, password:=password, writerespassword:=password
save_bk = Err.Number
Application.DisplayAlerts = True
On Error GoTo 0
End Function
Private Sub Workbook_Open()
UserForm1.Show
End Sub
2)標準モジュール内
'======================================================================
Public Type output_data
btn As Boolean 'true : okボタンがクリック False:Cancelボタンがクリック
pass_str As String 'btnがTrueのとき、パスワード
End Type
'======================================================================
Sub パスワード付読込()
Dim pass_word As output_data
Dim openbk As Workbook
Dim retcode As Long
pass_word = パスワード入力()
If pass_word.btn = True Then
retcode = open_bk(openbk, "c:\test.xls", pass_word.pass_str)
If retcode <> 0 Then
If retcode = 1004 Then
MsgBox "パスワードが違います"
Else
MsgBox Error(retcode)
End If
Else
MsgBox "ブックは、オープンされました"
End If
End If
End Sub
'========================================================================
Function パスワード入力() As output_data
'ユーザーフォームからパスワードを入力させる
'Output パスワード入力
Load UserForm1
With UserForm1
.TextBox1.PasswordChar = "*"
.Show
パスワード入力.btn = .ok
パスワード入力.pass_str = .TextBox1.Text
End With
Unload UserForm1
End Function
'========================================================================
Function open_bk(bkobj As Workbook, bk_path, Optional password = "") As Long
'指定されたパス名のブックをオープンする
On Error Resume Next
open_bk = 0
Set bkobj = Workbooks.Open(Filename:=bk_path, password:=password, _
writerespassword:=password)
open_bk = Err.Number
On Error GoTo 0
End Function
'*************************************
まーったくわからないので
お願い致します。
|
|
day aftar tomo
- 04/8/28(土) 20:33 -
