| |
・すべてのシートをパスワード付で保護しておく。
・許可されたユーザーが開いた場合のみ、シートの保護を解除して開いてやる。
・ブックの保存のオペレーションをした場合には、
強制的に各シートへのパスワード保護をかけた上で保存するようにする。
（前提）
マクロ無効で開けば、シートの保護が有効のままで編集できないという理屈。
シートの保護パスワードは、許可されたユーザー以外は知らない前提です。
ブックモジュールに、
Option Explicit
Const cnsOkId As String = "xxxxxxx"
Const cnsPathWd As String = "pasword"
>Private Declare Function GetUserName Lib "ADVAPI32.dll" _
> Alias "GetUserNameA" _
> (ByVal lpBuffer As String, nSize As Long) As Long
Private ColShts As Collection
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sh As Object
'保存する時は、シートのパスワード保護をかけてから保存する。
Set ColShts = New Collection
For Each sh In Me.Sheets
If Not sh.ProtectContents Then
sh.Protect cnsPathWd
'保存後に保護解除する為保護されていなかったシートを覚えておく
ColShts.Add sh
Else
On Error Resume Next
sh.Unprotect cnsPathWd
sh.Protect cnsPathWd
On Error GoTo 0
End If
Next
Application.OnTime Now(), Me.CodeName & ".AfterSaveProc"
End Sub
'保存した後に、保護してなかったシートの保護を解除してやる。
Private Sub AfterSaveProc()
Dim sh As Object
Application.ScreenUpdating = False
For Each sh In ColShts
sh.Unprotect cnsPathWd
Next
Application.ScreenUpdating = True
Me.Saved = True
Set ColShts = Nothing
End Sub
>Private Sub Workbook_Open()
> Dim strBuffer As String
> Dim lngLngs As Long
> Dim lngRet As Long
> Dim myID As String
Dim sh As Object
>
> ' Bufferを確保
> strBuffer = String(256, Chr(0))
> lngLngs = Len(strBuffer)
>
> ' ログインユーザー名取得
> lngRet = GetUserName(strBuffer, lngLngs)
> ' Null文字の手前までを有効として表示
> myID = Left$(strBuffer, InStr(1, strBuffer, Chr(0)) - 1)
>
If myID = cnsOkId Then
'許可されたユーザーだったら、シートのパスワード保護を解除する
Application.ScreenUpdating = False
On Error Resume Next
For Each sh In Me.Sheets
sh.Unprotect cnsPathWd
Next
Application.ScreenUpdating = True
Me.Saved = True
End If
>End Sub
落ち度がありそうですが、ある程度希望に適いませんかね。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
