| |
▼mixi さん、かみちゃんさん、こんにちは。
>データーベースとして使っているエクセルブックを
>ボタンから開く際にパスワードを入力しないと開けなくし
>特定の人しか変更等出来ないようにしたいのですが・・・
>術が分かりませんのでご教授ください。
データベースとなるブックにパスワードを付けたらいかがですか？
パスワードは､手動操作で保存しなおせば付けられます。
仮にこのデータベースとしてのブックをsvsample.xlsとしましょう。
以下のコードでもパスワード付で保存します。
'==============================================================
Const パスワード = "ichinose" '←パスワード
Sub パスワード付保存()
Dim retcode As Long
retcode = save_bk(Workbooks("svsample.xls"), "D:\My Documents\ＴＥＳＴエリア\svsample.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
**************************************************************************
次に読み込み時は、ユーザーフォーム（Userform1）でパスワードを
入力させてみましょう。
ユーザーフォーム（UserForm1）には、
テキストボックス（TextBox1）---パスワード入力用
コマンドボタン（CommandButton1）--「ＯＫ」ボタン
コマンドボタン（CommandButton2）---「Cancel」ボタン
の三つのコントロールをパスワード入力フォームっぽい配置で作成して下さい。
標準モジュールに
'======================================================================
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, "D:\My Documents\ＴＥＳＴエリア\svsample.xls", pass_word.pass_str)
If retcode <> 0 Then
If retcode = 1004 Then
MsgBox "パスワードが違います"
Else
MsgBox Error(retcode)
End If
Else
MsgBox openbk.Name & "は、オープンされました"
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
'*************************************
次いでUserForm1のモジュールに
'=========================================================================
Public ok As Boolean
'=========================================================================
Private Sub CommandButton1_Click()
ok = True
Me.Hide
End Sub
'=========================================================================
Private Sub CommandButton2_Click()
ok = False
Me.Hide
End Sub
'=========================================================================
Private Sub UserForm_Activate()
ok = False
TextBox1.SetFocus
End Sub
'=========================================================================
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub
これでプロシジャー「パスワード付読込」を実行してみて下さい。
|
|
