| |
▼kouka さん：
こんにちは。
>何度『はい』を押しても出てきてしまうので
・・・ですよね。失礼致しました。
Sub Auto_Close()
With ThisWorkbook
If Not .ReadOnly Then
SetAttr .FullName, vbNormal
If MsgBox("保存しますか？", vbYesNo) = vbYes Then
Application.EnableEvents = False
.Save
Application.EnableEvents = True
Else
.Saved = True
End If
End If
End With
End Sub
これでどうでしょう。
でも、
>最初に開いた時に元ファイルを別名保存してテンポラリーファイル的な使い方をする。
な案。
'-------------------------------------------------------------------------------
Option Explicit
Private MyName As String 'これはセルに書込み、記録しておいたほうが良いかも
Private TmpName As String '〃（作業用ファイルで、どうせKillするので固定でいいかも）
'-------------------------------------------------------------------------------
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
MyName = .FullName
TmpName = .Path & "\$" & .Name
Application.DisplayAlerts = False
.SaveAs TmpName
Application.DisplayAlerts = True
SetAttr MyName, vbReadOnly
' .Sheets("sheet1").Range("A1").Value = MyName
' .Sheets("sheet1").Range("A2").Value = TmpName
End If
End With
End Sub
'-------------------------------------------------------------------------------
Sub Auto_Close()
With ThisWorkbook
If Not .ReadOnly Then
' If IsEmpty(MyName) Then .Sheets("sheet1").Range("A1").Value
' If IsEmpty(TmpName) Then .Sheets("sheet1").Range("A2").Value
SetAttr MyName, vbNormal
If MsgBox("元ファイルへ反映しますか？", vbYesNo) = vbYes Then
Application.DisplayAlerts = False
.SaveAs MyName
Application.DisplayAlerts = True
Else
.Saved = True
'現在開いているファイルを読み取り専用開いている事にする
.ChangeFileAccess xlReadOnly
End If
On Error GoTo errLine
Kill TmpName
End If
End With
Exit Sub
'念の為
errLine:
MsgBox "TEMPファイル：" & TmpName & "が削除できませんでした。確認してください。"
End Sub
'-------------------------------------------------------------------------------
|
|
Ned
- 06/6/8(木) 10:08 -
