| |
こんにちは。
駄案に近いので、十二分にテストして、不具合あったら即捨ててください^ ^;
■標準モジュール
Sub Auto_Open()
'最初に開いた時に、ファイル属性を読み取り専用にする _
＆使用中のユーザーを書き込みor読み込み（ThisWorkbook.Pathのuse.txt）
Dim st As String
Dim fn As Long
fn = FreeFile
With ThisWorkbook
If .ReadOnly Then
Open .Path & "\use.txt" For Input As #fn
Input #fn, st
Close #fn
MsgBox st & " Open"
.Close savechanges:=False
Else
Open .Path & "\use.txt" For Output As #fn
Print #fn, Application.UserName
Close #fn
Call Set_ReadOn
End If
End With
End Sub
Sub Auto_Close()
'閉じる時、読み取り専用で開いていなければ、 _
最初に開いている事になるので属性をNormalに戻す
If Not ThisWorkbook.ReadOnly Then Call Set_Normal
End Sub
Sub Set_ReadOn()
'ファイル属性を読み取り専用にする
Dim MyNm As String
Dim MyAt As VbFileAttribute
MyNm = ThisWorkbook.FullName
MyAt = GetAttr(MyNm)
If Not MyAt = vbReadOnly Then SetAttr MyNm, vbReadOnly
End Sub
Sub Set_Normal()
'ファイル属性の読み取り専用を解除
Dim MyNm As String
Dim MyAt As VbFileAttribute
MyNm = ThisWorkbook.FullName
MyAt = GetAttr(MyNm)
If Not MyAt = vbNormal Then SetAttr MyNm, vbNormal
End Sub
■ThisWorkbookモジュール
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'保存時、読み取り専用を解除して保存→読み取り専用に戻す
Cancel = True
Call Set_Normal
Application.EnableEvents = False
ThisWorkbook.Save
Application.EnableEvents = True
Call Set_ReadOn
End Sub
つまり、ファイルを最初に開いた後、必ず読み取り専用になるように、ファイル属性を変更します。
アーカイブ属性など設定されていたら、少しやっかいですのでこのコードは使えません。
読み取り専用のままだと保存時に困るので、読み取り解除→保存→読み取り設定にします。
また、読み取り専用だと使用中ユーザーが（たぶん）取得できませんのでテキストファイルを使います。
>出来ればこのファイル一つでやりたいです。
がね...相当やっかいだと思いますけど。
安全策をとるとすれば、ダミーファイルを用意して、
そちらから開くようにしたほうが良いと思うんですけどね...
その場合は
Application.DisplayAlerts = False
が効くと思うので。
|
|
Ned
- 06/6/7(水) 0:09 -
