事務職のためのExcelVBA入門講座 > ExcelVBAサンプルマクロ > 保存確認メッセージを自作する

ExcelVBAサンプルマクロ

保存確認メッセージを自作する

VBAでSaveAsメソッドを実行した時、すでに同じ名前のファイルがあると
自動的にダイアログが表示されますが、「いいえ」や「キャンセル」を押すと「実行時エラー'1004': 'SaveAs'メソッドは失敗しました」が出てしまいます。

このため、エラーを出さずにきちんと処理したい場合は処理を自分で組む必要があります。
まずはサンプルコードから。

サンプルコード



Sub 保存確認メッセージ()

Dim strFilePath As String
Dim strFileName As String
Dim flg As Boolean

'◆保存するパスの設定
strFilePath = ThisWorkbook.Path & "¥"

Do Until flg = True
  '◆保存するファイル名の入力
  strFileName = InputBox("ファイル名を入力してください。(拡張子不要)")

  If strFileName = "" Then
    MsgBox "保存をキャンセルします。"
    Exit Sub
  End If

  '◆拡張子がなければつける
  If Right$(strFileName, 4) <> ".xls" Then
    strFileName = strFileName & ".xls"
  End If

  '◆ファイルに使えない文字が入っているかチェック
  If strFileName Like "*[¥,/,"""",:,<,>,?,*,|]*" Then
    MsgBox "ファイル名に使えない記号が含まれています。"
  Else
    '◆開いているかチェック
    If fncBookOpen(strFileName) = False Then
      '◆入力したファイル名が保存先にあるかチェック
      If Dir(strFilePath & strFileName) = "" Then
        flg = True
      Else
        If MsgBox(strFileName & "はすでに存在します。上書きしますか?", vbYesNo + vbDefaultButton2) = vbYes Then
          Application.DisplayAlerts = False
          flg = True
        End If
      End If
    End If
  End If
Loop

ThisWorkbook.SaveAs strFilePath & strFileName

End Sub


Public Function fncBookOpen(strFileName As String) As Boolean

'◆ファイルが開いているかチェック
'  (開いている→True、開いていない→False)

On Error GoTo NotOpen

Workbooks(strFileName).Activate

'◆開いている場合
If ThisWorkbook.Name <> strFileName Then
  If MsgBox("すでに同じ名前のファイルが開いています。開いているファイルを閉じて、" & vbCrLf & _
    "このファイルを「 " & strFileName & "」という名前で保存しますか?", vbYesNo) = vbYes Then
      Workbooks(strFileName).Close
  Else
    fncBookOpen = True
  End If
End If

NotOpen:  '◆開いていない場合
ThisWorkbook.Activate

End Function

まじめに処理しようと思うとコードが長くなりますが、
「IFステートメント」「Do...Loopステートメント」などの基本的なものしか使っていません。

条件分岐がややこしい場合は、フローチャートで考えてみるとわかりやすくなります。
ファイル保存のフローチャート

ファイル名を入力させるテキストボックスはInputBox関数で表示します。
キャンセルをした場合は""が返るので、""の場合はExit Subでプロシージャを抜けます。

次に、入力されたファイル名に拡張子をつけます。
InputBoxのメッセージには「(拡張子不要)」と表示するのですが、そう書いてあっても
拡張子まで含めて入力してしまう人が1人2人は出ることを考えて、「拡張子がなかったらつける」という形にしています。

その後はファイル名に使えない文字が入っていないか、同名のブックを開いていないか、保存先フォルダに同名のファイルがないかを
順にチェックしていきます。

長くなりそうだったので、ファイルが開いているかのチェックは
別にユーザー定義関数「fncBookOpen」を作り、本体から分けました。

チェックがOKだったら変数flgをTrueにします。
するとDo...Loopステートメントの終了条件を満たすので、繰り返し処理を抜けてファイル保存をします。


ファイルが開いているかどうかをチェックするユーザー定義関数「fncBookOpen」はまず、エラーが出た場合ラベル「NotOpen」へ
飛ぶようにOn Resume GoToステートメントを記述しておきます。

引数で指定したブックをアクティブにし、開いていなければエラーが発生します(NotOpenへ飛ぶ)

エラーが発生した場合は保存もとのブックをアクティブにして終わります。
ユーザー定義関数「fncBookOpen」の戻り値はBoolean型で、
Boolean型の初期値はFalseなのでエラーが出た場合(ブックを開いてない場合)はFalseが返ります。


エラー処理をせずにFor Each...Nextステートメントでループさせて
判定してもいいのですが、For Each...Nextステートメントで処理する場合は、
strConv関数で大文字・小文字を揃えてからファイル名を判定する必要があって面倒なので、こっちの方法を採用しました。


ただ、見てのとおり真面目に保存するファイル名を判定しようとすると
かなり面倒くさいです。
これくらい書くくらいだったら、普通にSaveAsメソッドで1行書いてしまって
操作する人がキャンセルしないように気をつける、間違えたら一度終了させて再度実行する、といった運用を徹底した方が
すっきりする・・・・・・かもしれません。

<<重複しないファイル名をつける | 事務職のためのExcelVBA入門講座トップへ | 入力規則に合ったデータが入力されているか確認する>>

この記事へのコメント

コメントを書く

お名前
メールアドレス
URL
コメント
[必須入力]
認証コード
[必須入力]


※画像の中の文字を半角で入力してください。

この記事へのトラックバック


Powered by Seesaa
×

この広告は1年以上新しい記事の投稿がないブログに表示されております。