「上書き保存」で一度警告を出す方法

Word、Excelの2003を使っています。
「上書き保存」（フロッピーディスクのアイコン？）をクリックしたときに１回「上書き保存されます、よろしいですか？」の類の警告メッセージを出すことはできるのでしょうか？
昔、同僚だった人のPCを使って作業していたときはそのようなメッセージが出てくれて、もとのデータを消失してしまったり、「名前をつけて保存」と押し間違うことがなく良かったのですが。

No.3 ベストアンサー 回答者： Wendy02 回答日時： 2009/01/26 15:30

こんにちは。

>昔、同僚だった人のPCを使って作業していたときはそのようなメッセージが出てくれて、

それは、見かけの「上書き保存(FaceID = 3)」のアイコンを使い、中身は、別のコマンドを呼んでいるだけだと思います。

　On Error Resume Next
　ActiveWorkbook.SaveAs ActiveWorkbook.Name
　On Error GoTo 0

しかし、以下は、実際に私が使っているものを書き換えたもので、私のものは、もう少し複雑な働きをしています。ただ、Ctrl + S を設定だけは、意図的に抜いています。必要なら、付け加えます。

一旦保存して、再起動すると、設定されています。
Wordに関しては、時間があったら、また、書き込みます。

「個人用マクロブック」に登録してください。

'標準モジュール

Private ClassBtns(1) As New Class1
Public cnt As Integer
Sub Auto_Open()
With Excel.Application
　Set ClassBtns(0).Btn = .CommandBars("Standard").FindControl(, 3)
　Set ClassBtns(1).Btn = .CommandBars("File").FindControl(, 3)
　End With
End Sub


'クラスモジュール (Class1)
Private WithEvents myBtn As Office.CommandBarButton
Public Property Set Btn(ByVal myNewBtn As CommandBarButton)
　Set myBtn = myNewBtn
End Property
Private Sub myBtn_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
　　Dim FileName As String
　　Dim Ret As VbMsgBoxResult
　　If cnt > 0 Then
　　　　cnt = 0
　　　　Exit Sub
　　End If
　　FileName = ActiveWorkbook.Name
　　cnt = cnt + 1
　　If FileName Like ".xl?" Then
　　　　Application.Dialogs(xlDialogSaveAs).Show
　　　　Exit Sub
　　End If
　　If Dir(FileName) <> "" Then
　　　　Ret = MsgBox("この場所に'" & FileName & "'というファイルが既にあります。置き換えますか？", vbYesNoCancel + vbExclamation)
　　　　If Ret = vbYes Then
　　　　　　ActiveWorkbook.Save
　　　　　　Exit Sub
　　　　ElseIf Ret = vbNo Then
　　　　　　Application.Dialogs(xlDialogSaveAs).Show FileName
　　　　　　Exit Sub
　　　　Else
　　　　　　Exit Sub
　　　　End If
　　End If
End Sub
　　
なお、全ての保存に対してメッセージが出るのではなく、既に、同じフォルダに同名のファイルがある場合に出ることとと、上書きにコマンドを使ったときにだけでます。また、Workbook_BeforeSave イベントは、あくまでも、自ブックだけです。Application イベントを作らなくてはなりません。しかし、もともと、ボタンに対するものならば、ボタンにインスタンス等を設定したほうが楽です。

この回答へのお礼

ありがとうございます。ご回答の内容は保存させていただき、勉強して理解できるようになったら実施したいと思います。ありがとうございました。

お礼日時：2009/01/27 11:30

No.4 回答者： Wendy02 回答日時： 2009/01/26 21:37

追加

#3のWordのコードです。Normal.dot に登録してください。

なお、ふだんは、オブジェクトは壊れないのですが、Excel/Wordとも、コードをいじらないように、プロジェクトを簡単なパスワードでロックしたほうがよいです。

'--------------------------------------------
'標準モジュール

Private ClassBtns(1) As New Class1
Public cnt As Integer

Sub Auto_Open()
With Word.Application
　Set ClassBtns(0).Btn = .CommandBars("Menu Bar").Controls("ファイル(&F)").Controls("上書き保存(&S)")
　Set ClassBtns(1).Btn = .CommandBars("Standard").FindControl(, 3)
End With
End Sub
'--------------------------------------------

'クラスモジュール (Class1)
Private WithEvents myBtn As Office.CommandBarButton
Public Property Set Btn(ByVal myNewBtn As CommandBarButton)
　Set myBtn = myNewBtn
End Property
Private Sub myBtn_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
　　Dim FileName As String
　　Dim Ret As VbMsgBoxResult
　　If cnt > 0 Then
　　　　cnt = 0
　　　　Exit Sub
　　End If
　　FileName = ActiveDocument.Name
　　cnt = cnt + 1
　　If FileName Like ".do?" Then
　　　　Application.Dialogs(xlDialogSaveAs).Show
　　　　Exit Sub
　　End If
　　If Dir(FileName) <> "" Then
　　　　Ret = MsgBox("この場所に'" & FileName & "'というファイルが既にあります。置き換えますか？", vbYesNoCancel + vbExclamation)
　　　　If Ret = vbYes Then
　　　　　　ActiveDocument.Save
　　　　　　Exit Sub
　　　　ElseIf Ret = vbNo Then
　　　　　　Application.Dialogs(wdDialogFileSaveAs).Show FileName
　　　　　　Exit Sub
　　　　Else
　　　　　　Exit Sub
　　　　End If
　　End If
End Sub
'--------------------------------------------

No.2 回答者： marbin 回答日時： 2009/01/26 15:19

エクセルでしたら、

Workbook_BeforeSaveイベント
でブック保存時にマクロを起動して所定
の作業を行うことが出来ますが、
ワードには、これに該当するイベントが
見当たりません。
あるのかもしれませんが。

ドキュメントを閉じるときには
Document_Closeイベント
で所定の作業を行うことは出来ます。

この回答へのお礼

ありがとうございます。もっと勉強してから出直したいと思います。ありがとうございました。

お礼日時：2009/01/27 11:28

No.1 回答者： mt2008 回答日時： 2009/01/26 15:13

「上書き」ボタンは、警告や確認無しで上書き保存する為のボタンですのですので、標準では警告を出すようには出来ないと思います。

「同僚だった人」に、設定を確認する事はできないのですか？

上書き前に警告を出したいのでしたら、ツールバーから「上書き」ボタンを消して、常に名前を付けて保存で保存する事にしても良いですね。

または、ExcelならThisWorkbook に、↓の様なマクロを入れる事で保存前に警告を出せますが……。
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
　If SaveAsUI = False Then
　　If MsgBox("上書き保存します。", vbOKCancel) = vbCancel Then Exit Sub
　End If
End Sub

この回答へのお礼

回答ありがとうございます。そうですね。「上書き」の意味を軽く考えていました。反省です。ありがとうございました。

お礼日時：2009/01/27 11:27