Excel VBA質問箱 IV

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

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


8681 / 13645 ツリー ←次へ | 前へ→

【31753】別名で保存を促し、上書き保存せず終了 ミナミ 05/11/29(火) 17:11 質問[未読]
【31779】Re:別名で保存を促し、上書き保存せず終了 とちゃ 05/11/30(水) 0:17 回答[未読]
【31832】Re:別名で保存を促し、上書き保存せず終了 ミナミ 05/11/30(水) 17:28 お礼[未読]

【31753】別名で保存を促し、上書き保存せず終了
質問  ミナミ  - 05/11/29(火) 17:11 -

引用なし
パスワード
   こんにちは。
初めてですが、質問させて下さい。

マクロを含むファイルを更新した場合に別名で保存を促し、
保存しないことを確認後、上書き保存せず終了という処理を組んでみました。
大まかな動きは想定どおりなのですが、別名保存をキャンセルし、
次表示のメッセージで「OK」とすると上書き保存の確認メッセージが出てきてしまいます。ここで「いいえ」を選択するとEXCELが異常終了してしまうのです。
閉じるときにはThisWorkbook.SavedをTrueにしているので上のメッセージは出ないはずなのですが・・・
皆様のお力を貸していただけないでしょうか。よろしくお願いします。
以下がコードです。ちなみにEXCELのバージョンは97です。


'EXCELシート上の終了ボタンを押すと起動
Sub 終了()
  if quit() then
    ThisWorkbook.close
  end if
End Sub

'終了時の保存判定用関数
Function quit() As Boolean
  Dim strFilename As String  '保存ファイル名
  quit = False
  If ThisWorkbook.Saved Then
      quit = True
      Exit Function
  End If
  strFilename = ThisWorkbook.Path & "\" & _
         "データ作成" & "_" & _
         Format(Date, "yyyymmdd") & ".xls"
  strFilename = Application.GetSaveAsFilename( _
    FileFilter:="Excelファイル,*.xls", _
    InitialFilename:=strFilename, _
    Title:="Excelファイルの保存")
  If strFilename = "False" Then
    If MsgBox("保存せずに終了します。よろしいですか?", _
         vbOKCancel + vbInformation, _
         "終了確認") = vbOK Then
      ThisWorkbook.Saved = True
      quit = True
      Exit Function
    Else
      quit = False
      Exit Function
    End If
  End If
End Function

'終了(または、強制終了)時に保存しない。
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  If quit() = False Then
    Cancel = True
    Exit Sub
  End If
  Me.Saved = True
End Sub

【31779】Re:別名で保存を促し、上書き保存せず終了
回答  とちゃ  - 05/11/30(水) 0:17 -

引用なし
パスワード
   こんばんは、もうお休みになってますかね?
私はここの常連の解答者の皆様のように詳しい方ではありませんが、なかなか解答が付かないようなので、以下お答えさせて戴きます。

先ず、現行プログラムを見たところ、ファンクションプロシージャの中にメッセージボックスなど記述されてますが、ファンクションプロシージャはエクセルシート上で頻繁に使用するユーザー定義関数の設定、或いはマクロのプログラムの中で何度も特別な計算が繰返し必要になる場合に便利なもので、この中に計算目的以外のコードが含まれるのはちょっと違和感がありますね。

また、quit()で求められようとしている戻り値は、ThisWorkbook.Savedのプロパティを取得することで事足りると思います。

ということで、以下のように変更してみました。

Sub 終了()
  If ThisWorkbook.Saved = False Then
    strFilename = ThisWorkbook.Path & "\" & _
         "データ作成" & "_" & _
         Format(Date, "yyyymmdd") & ".xls"
    strFilename = Application.GetSaveAsFilename( _
      FileFilter:="Excelファイル,*.xls", _
      InitialFileName:=strFilename, _
      Title:="Excelファイルの保存")
    If strFilename = "False" Then
      If MsgBox("保存せずに終了します。よろしいですか?", _
          vbOKCancel + vbInformation, _
          "終了確認") = vbOK Then
        ThisWorkbook.Saved = True
        ThisWorkbook.Close
      Else
        Exit Sub
      End If
    Else
      ActiveWorkbook.SaveAs strFilename
    End If
  Else
    ThisWorkbook.Close
  End If
End Sub

'------(このイベントプロシージャは言わずもがな標準モジュールではなく、ThisWorkbookのモジュールに記述して下さい。)------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  終了
End Sub

なお、私は外地に居るもので、もし更なるご質問がありましたら、直ぐにお答えできる時間帯か分かりませんので、他の人に助けてもらった方が早いかも。

【31832】Re:別名で保存を促し、上書き保存せず終了
お礼  ミナミ  - 05/11/30(水) 17:28 -

引用なし
パスワード
   ▼とちゃ さん:
こんばんわ?になるのでしょうか^^

ご回答のコード、早速試させていただきました。
問題点、無事解決致しました!Functionの用途まで教えていただき、大変勉強になりました。本当にありがとうございました。

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