ブックを新規作成し、同名ファイルを確認、名前を付けて上書き保存後閉じる:Excelでよく使うフレーズ

ブックの新規作成はAddメソッド、名前を付けて保存はSaveAsメソッド、閉じるにはCloseメソッドを使用します。

名前を付けて上書き保存するには、Application.DisplayAlerts = False を保存する前に実行すれば、警告メッセージを表示せずに保存できます。

同名ファイルの確認は以前掲載したTipsの、「ファイル・フォルダの存在確認」 を参照してください。

Excelでよく使うフレーズのサンプルのメニューに戻る

スポンサーリンク





新規ブックを作成する

Addメソッドで新規ブックを作成するVBAです。
Addメソッドで新規ブックを作成するVBA

Sub MyNewBook()
    Workbooks.Add
End Sub

名前を付けて保存する

C2セルに保存する新規ファイル名を入力しておきます。
C2セルに保存する新規ファイル名を入力

SaveAsメソッドで名前を付けて保存するVBAです。
SaveAsメソッドで名前を付けて保存するVBA

・Filenameパラメーターでファイル名を指定します。

Sub MyNewBook()
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=Range("C2") & ".xlsx"
End Sub

実行結果です。
ブック名が表示されています。
実行結果

スポンサーリンク


同名ファイルを確認し、名前を付けて上書き保存する

C2セルに保存先のフォルダ名、C3セルにファイル名を入力しておきます。
C2セルに保存先のフォルダ名、C3セルにファイル名を入力

ファイルの存在確認し保存するVBAです。
ファイルの存在確認し保存するVBA

・ExDirプロシージャで同名ファイルの存在確認を行います。
・ExDirで空文字が返れば、存在しません
・同名ファイルが存在すれば、Application.DisplayAlerts = Falseで警告メッセージを表示しないようにし、SaveAsで保存します。

Private Function ExDir(sName As String, nAttr As Integer) As String
      If sName = "" Then
          ExDir = ""
          Exit Function
      End If
  On Error Resume Next
      Err.Number = 0
      ExDir = Dir(sName, nAttr)
      If Err.Number <> 0 Then
          ExDir = ""
      End If
  On Error GoTo 0
End Function
  
Sub MyNewBook()
    Dim sfina As String
    Dim twk As Workbook
    Dim lRet As Long
    
    Workbooks.Add
    
    sfina = Range("C2") & Range("C3") & ".xlsx"
    
    If ExDir(sfina, vbNormal) <> "" Then
        lRet = MsgBox("同名のファイルが存在します。" & vbCrLf & _
            "上書きしますか?", vbYesNo)
        If lRet = vbYes Then
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:=sfina
        End If
    Else
        ActiveWorkbook.SaveAs Filename:=sfina
    End If
End Sub

実行結果です。
同名ファイルが存在する場合に表示したメッセージです。
同名ファイルが存在する場合に表示したメッセージ

ブックを閉じる

Closeメソッドでブックを閉じるVBAです。
 Closeメソッドでブックを閉じるVBA

Sub MyNewBook()
    Dim sfina As String
    Dim twk As Workbook
    Dim lRet As Long
    
    Workbooks.Add
    
    sfina = Range("C2") & Range("C3") & ".xlsx"
    
    If ExDir(sfina, vbNormal) <> "" Then
        lRet = MsgBox("同名のファイルが存在します。" & vbCrLf & _
            "上書きしますか?", vbYesNo)
        If lRet = vbYes Then
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:=sfina
        Else
            Exit Sub
        End If
    Else
        ActiveWorkbook.SaveAs Filename:=sfina
    End If
    ActiveWorkbook.Close
End Sub

スポンサーリンク







Excelでよく使うフレーズのサンプルのメニューに戻る

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します


Copyright (c) Excel-Excel ! All rights reserved