Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


43187 / 76732 ←次へ | 前へ→

【38597】Re:Excelファイルを誰かが開いているとき...
発言  Ned  - 06/6/7(水) 0:09 -

引用なし
パスワード
   こんにちは。
駄案に近いので、十二分にテストして、不具合あったら即捨ててください^ ^;

■標準モジュール
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
が効くと思うので。

1 hits

【38514】Excelファイルを誰かが開いているときは開けないようにする件。 kouka 06/6/5(月) 16:12 質問
【38518】Re:Excelファイルを誰かが開いているときは... Kein 06/6/5(月) 17:12 回答
【38534】Re:Excelファイルを誰かが開いているときは... kouka 06/6/6(火) 9:19 発言
【38585】Re:Excelファイルを誰かが開いているときは... kouka 06/6/6(火) 18:27 発言
【38597】Re:Excelファイルを誰かが開いているとき... Ned 06/6/7(水) 0:09 発言
【38598】Re:Excelファイルを誰かが開いているとき... Ned 06/6/7(水) 0:41 発言
【38610】Re:Excelファイルを誰かが開いているとき... Ned 06/6/7(水) 10:50 発言
【38653】Re:Excelファイルを誰かが開いているとき... 漂流民 06/6/7(水) 23:47 発言
【38671】Re:Excelファイルを誰かが開いているとき... Ned 06/6/8(木) 11:09 発言
【38662】Re:Excelファイルを誰かが開いているとき... kouka 06/6/8(木) 9:44 質問
【38665】Re:Excelファイルを誰かが開いているとき... Ned 06/6/8(木) 10:08 発言
【38685】Re:Excelファイルを誰かが開いているとき... Ned 06/6/8(木) 14:52 発言
【38740】Re:Excelファイルを誰かが開いているとき... kouka 06/6/9(金) 11:03 お礼

43187 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free