ワークブックを保存

ワークブックを保存する方法になります。
例とそして５パターンの保存方法を列挙しました。
例１：上書き保存
例２：名前を付けて保存
例３：名前を付けて保存（上書き確認をしない）
例４：確認ダイアログを表示して保存するファイル名を指定
例５：名前を付けて保存（同じ名前がある場合は、ナンバリングして保存）

【サンプルプログラム】

Sub SampleProgram()
    Dim result As Boolean

    result = ExcelOpenFileSave_Example1("C:\ExcelVBA\ワークブック\Book1.xlsx")
    If result = False Then
        MsgBox "保存できませんでした"
    End If

    result = ExcelOpenFileSave_Example2("C:\ExcelVBA\ワークブック\Book1.xlsx", _
                                        "C:\ExcelVBA\ワークブック\Book2.xlsx")
    If result = False Then
        MsgBox "保存できませんでした"
    End If

    result = ExcelOpenFileSave_Example3("C:\ExcelVBA\ワークブック\Book1.xlsx", _
                                        "C:\ExcelVBA\ワークブック\Book2.xlsx")
    If result = False Then
        MsgBox "保存できませんでした"
    End If

    result = ExcelOpenFileSave_Example4("C:\ExcelVBA\ワークブック\Book1.xlsx")
    If result = False Then
        MsgBox "保存できませんでした"
    End If

    result = ExcelOpenFileSave_Example5("C:\ExcelVBA\ワークブック\Book1.xlsx")
    If result = False Then
        MsgBox "保存できませんでした"
    End If

End Sub

【例1】

' ------------------------------------------------------------
' 説明：Excelファイルを開いて上書き保存する
' 引数：1:読み込むファイル名
' 備考：ファイルが読み取り専用になっている場合の対策が必要
' ------------------------------------------------------------
Function ExcelOpenFileSave_Example1(ByVal in_name As String) As Boolean
    Dim wb As Workbook
    Dim ret As Boolean

    On Error Resume Next

    Set wb = Workbooks.Open(in_name)   ' ブックを開く

    ' ----------------------
    ' 例：適当な処理
    ' ----------------------
    wb.Sheets(1).Range("A1") = 123
    
    ' 読み取り専用が設定されている場合保存しないがエラーにもならないので保存処理しない
    If (GetAttr(in_name) And vbReadOnly) = vbReadOnly Then
        ExcelOpenFileSave_Example1 = False
    Else
        ' 上書き保存
        wb.Save
        ExcelOpenFileSave_Example1 = True
    End If
    
    ' ブックを閉じる(保存しない)
    wb.Close SaveChanges:=False
    Set wb = Nothing
End Function

【例2】

' ------------------------------------------------------------
' 説明：Excelファイルを開いて名前を付けて保存
'       既にファイルがある場合も、確認なく上書き保存
' 引数：1:読み込むファイル名
'       2:書き込むファイル名
' 備考：
' ------------------------------------------------------------
Function ExcelOpenFileSave_Example2(ByVal in_name As String, ByVal out_name As String) As Boolean
    Dim wb As Workbook

    On Error Resume Next

    Set wb = Workbooks.Open(in_name)   ' ブックを開く

    ' ----------------------
    ' 例：適当な処理
    ' ----------------------
    wb.Sheets(1).Range("A1") = 456

    ' 名前を付けて保存（既にファイルがある場合、上書き保存）
    Application.DisplayAlerts = False   ' 確認メッセージを非表示
    wb.SaveAs out_name                  ' ファイルを出力
    Application.DisplayAlerts = True    ' 確認メッセージを表示(元に戻す)
    
    If Err.Number > 0 Then
        ExcelOpenFileSave_Example2 = False
    Else
        ExcelOpenFileSave_Example2 = True
    End If
    
    ' ブックを閉じる(保存しない)
    wb.Close SaveChanges:=False
    Set wb = Nothing
End Function

【例3】

' ------------------------------------------------------------
' 説明：Excelファイルを開いて名前を付けて保存
'       既にファイルがある場合は確認画面を出す
'       既にファイルがある場合は、確認なく上書き保存
' 引数：1:読み込むファイル名
'       2:書き込むファイル名
' 備考：読み取り専用ファイルに保存しようとすると、確認画面は出ない
' ------------------------------------------------------------
Function ExcelOpenFileSave_Example3(ByVal in_name As String, ByVal out_name As String) As Boolean
    Dim wb As Workbook

    On Error Resume Next

    Set wb = Workbooks.Open(in_name)   ' ブックを開く

    ' ----------------------
    ' 例：適当な処理
    ' ----------------------
    wb.Sheets(1).Range("A1") = 789

    ' 名前を付けて保存するが、既にファイルがある場合は確認画面を出す
    wb.SaveAs out_name

    ' 「いいえ」と「キャンセル」への対応（保存できなかった場合も同じ）
    If Err.Number > 0 Then
        ExcelOpenFileSave_Example3 = False
    Else
        ExcelOpenFileSave_Example3 = True
    End If
    
    ' ブックを閉じる(保存しない)
    wb.Close SaveChanges:=False
    Set wb = Nothing
End Function

【例4】

' ------------------------------------------------------------
' 説明：Excelファイルを開いて名前を付けて保存
'       既にファイルがある場合は、確認なく上書き保存
' 引数：1:読み込むファイル名
'       2:書き込むファイル名
' 備考：
' ------------------------------------------------------------
Function ExcelOpenFileSave_Example4(ByVal in_name As String) As Boolean
    Dim wb As Workbook
    Dim out_name As Variant

    On Error Resume Next

    Set wb = Workbooks.Open(in_name)   ' ブックを開く

    ' ----------------------
    ' 例：適当な処理
    ' ----------------------
    wb.Sheets(1).Range("A1") = "ABC"

    'ダイアログで保存先・ファイル名を指定
    out_name = Application.GetSaveAsFilename

    ' 「いいえ」と「キャンセル」への対応
    If out_name = False Then
        ExcelOpenFileSave_Example4 = False
    Else
        wb.SaveAs out_name
        ' 上書き保存の場合、「いいえ」と「キャンセル」への対応
        If Err.Number > 0 Then
            ExcelOpenFileSave_Example4 = False
        Else
            ExcelOpenFileSave_Example4 = True
        End If
    End If
    
    ' ブックを閉じる(保存しない)
    wb.Close SaveChanges:=False
    Set wb = Nothing
End Function

【例5】

' ------------------------------------------------------------
' 説明：Excelファイルを開いて名前を付けて保存
'       既にファイルがある場合はナンバリングしたファイル名で保存
'       既にファイルがある場合は、確認なく上書き保存
' 引数：1:読み込むファイル名
'       2:書き込むファイル名
' 備考：
' ------------------------------------------------------------
Function ExcelOpenFileSave_Example5(ByVal in_name As String, ByVal out_name As String) As Boolean
    Dim wb As Workbook

    Set wb = Workbooks.Open(in_name)   ' ブックを開く

    ' ----------------------
    ' 例：適当な処理
    ' ----------------------
    wb.Sheets(1).Range("A1") = "DEF"

    out_name = FilenameAddNumber(out_name)
    If out_name = "" Then
        ExcelOpenFileSave_Example5 = False
    Else
        wb.SaveAs out_name
        ExcelOpenFileSave_Example5 = True
    End If
    
    ' ブックを閉じる(保存しない)
    wb.Close SaveChanges:=False
    Set wb = Nothing
End Function

例５を使用する場合は、ナンバリングしたファイル名を作成するから、FilenameAddNumber()関数をコピーしてください。