Excel VBA質問箱 IV

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

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


43175 / 76732 ←次へ | 前へ→

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

引用なし
パスワード
   こんにちは。一夜明けて、よく見たら変な事してましたね^ ^;

■標準モジュール
Sub Auto_Open()
  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 False
    Else
      Open .Path & "\use.txt" For Output As #fn
      Print #fn, Application.UserName
      Close #fn
      SetAttr .FullName, vbReadOnly
    End If
  End With
End Sub

Sub Auto_Close()
  With ThisWorkbook
    If Not .ReadOnly Then SetAttr .FullName, vbNormal
  End With
End Sub

Sub Cstm_Save()
  With ThisWorkbook
    SetAttr .FullName, vbNormal
    Application.EnableEvents = False
    .Save
    Application.EnableEvents = True
    SetAttr .FullName, vbReadOnly
  End With
End Sub

Sub NewName_Save()
  Dim NewNm As Variant
  With ThisWorkbook
    Do
      NewNm = Application.GetSaveAsFilename _
        (.Name, "Microsoft Excelブック,*.xls")
      If VarType(NewNm) = vbBoolean Then Exit Sub
      If Len(Dir(NewNm)) = 0 Then Exit Do
      If MsgBox("同名ファイル在り。置き換えしますか?", vbYesNo) _
        = vbYes Then Exit Do
    Loop
    SetAttr .FullName, vbNormal
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    .SaveAs NewNm
  End With
  Application.DisplayAlerts = True
  Application.EnableEvents = True
  SetAttr NewNm, vbReadOnly
End Sub

■ThisWorkbookモジュール
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Cancel = True
  If SaveAsUI Then
    Call NewName_Save
  Else
    Call Cstm_Save
  End If
End Sub

これくらいでいいかと思います。
ただ、OPEN中ファイルの属性変更に少し不安があるので、別案として
最初に開いた時に元ファイルを別名保存してテンポラリーファイル的な使い方をする。
その時元ファイルは読み取り専用に属性変更をする。
とすれば保存の度に属性変更する必要はなく、OpenとCloseの時だけ処理をすればいいですね^ ^
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 お礼

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