Excelのマクロ実行エラー1004の解決方法とは?

このQ&Aのポイント
  • 2007年のExcelでマクロを記述した際に実行エラー1004が発生し、「Save As メリードは失敗しました Workbookオブジェクト」というエラーメッセージが表示されます。具体的な解決方法は、ファイルの既存の有無に応じて処理を分岐させることであり、ファイルが既に存在する場合は置き換え保存を行い、存在しない場合は新規保存を行います。
  • 具体的な記述方法は、以下の通りです。まず、ファイルの有無を確認し、存在する場合は置き換え保存を行います。ファイルが存在しない場合は新規保存を行います。その後、新規作成したブックを閉じます。
  • このようにして、Excelのマクロ実行エラー1004を解決することができます。マクロを記述する際は、ファイルの有無を適切に処理することが重要です。
回答を見る
  • ベストアンサー

2010excel の記述方法

2007excelでマクロを記述したものが、実行エラー1004 「Save As メリッドは失敗しました Workbookオブジェクト」と表示されます。 テバックすると NewWkbook.SaveAs FileName:=FileName, FileFormat:=xlExcel8 がエラー表示されます。 すいません、教えてください If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close saveChanges:=False '##保存せずに終了 Exit Sub End If '##指定ファイル置き換え保存 NewWkbook.SaveAs FileName:=FileName, FileFormat:=xlExcel8 Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName, FileFormat:=xlExcel8←黄色 End If ' NewWkbook.Close saveChanges:=False Application.DisplayAlerts = True

質問者が選んだベストアンサー

  • ベストアンサー
回答No.2

こんにちは。 xlExcel8--旧ファイル・フォーマットで保存するのは、人に渡すためでしょうか? Excel2007以上ですと、こうしたパブリック性を考慮するのでしたら、Shape(Button?) 削除したり、印刷不可にしておいて、pdf などに保存したほうが早いような気がします。もしくは、xlsx のファイル・フォーマットで保存するか、どちらかだと思います。厳密に言えば、ドキュメント検査や互換性チェックを調べる方法も加えます。 コードの趣旨は分かりましたが、未だ、肝心な部分が残っていて、その都度、小出しに情報を出されても、全文を出さない限りは、#1さんと同じようになってしまいます。もちろん、こちら側で、新たに書きなおすことは可能だとは思いますが、業務上の守秘義務とかあるでしょうから、現状で今アドバイス出来る部分というと、 >'##指定ファイル置き換え保存 > NewWkbook.SaveAs FileName:=FileName, FileFormat:=xlExcel8 '<--NG こっちの置き換え保存というのは、ありえないと思います。 「実行エラー1004」ですから、 NewWkBook.Save 'FileName等は不要 のはずです。他にも疑問点は存在しますが、とりあえず、ここまでにしておきます。

pop2003
質問者

補足

返事が遅れてすいません。 NewWkBook.Save 'FileName等は不要 どのように記述を変えればよいか教えてください。それとPDFに変換し保存する方法も教えていただきたいです。

その他の回答 (1)

  • kybo
  • ベストアンサー率53% (349/647)
回答No.1

単純にNewWkbookオブジェクトに何も代入されていないからではないでしょうか? 例えば保存するのがアクティブブックだとすると以下の様な感じ NewWkbook.SaveAs FileName:=FileName, FileFormat:=xlExcel8 ↓以下に変更 Set NewWkbook = ActiveWorkbook NewWkbook.SaveAs Filename:=Filename, FileFormat:=xlExcel8

pop2003
質問者

補足

ありがとうございます。代入はしているのですがエラー回避ができません。 OldWkbook.Sheets(Array(StName1)).Copy Set NewWkbook = ActiveWorkbook For Each WS In NewWkbook.Worksheets WS.Unprotect Password:="1111" '←シートに保護を解除 For wIx = 1 To NewWkbook.Sheets(1).Shapes.Count NewWkbook.Sheets(1).Shapes(1).Delete '←シート1のボタンを削除 Next NewWkbook.Sheets(1).Name = StName1 WS.Protect Password:="1111" '←シートに保護を掛ける Next WS For Each objVBCOMPO In NewWkbook.VBProject.VBComponents With objVBCOMPO.CodeModule ' コードを削除(全行) lngLines = .CountOfLines If lngLines <> 0 Then .DeleteLines 1, lngLines End With Next objVBCOMPO ' FileName = "C:\議事録\" & FileName '保存 If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close saveChanges:=False '##保存せずに終了 Exit Sub End If '##指定ファイル置き換え保存 NewWkbook.SaveAs FileName:=FileName, FileFormat:=xlExcel8 Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName, FileFormat:=xlExcel8 End If ' NewWkbook.Close saveChanges:=False Application.DisplayAlerts = True End Sub

関連するQ&A

  • エクセル VBA シート保存ボタン

    Sheet上にボタンを作成 ボタンを押すと保存するようにしています! 以前ここでSheet2枚をコピー出来るような 記述教えてもらったのですが・・ 1枚ならどう変化して良いか・・ 記述を書きましたが 何処が違うか教えて下さい! Private Sub CommandButton1_Click()   Dim FileName  As String   Dim FileExt   As String   Dim BkName   As String   Dim OldWkbook  As Workbook   Dim NewWkbook  As Workbook   Const StName1  As String = "ko"      '   Application.DisplayAlerts = False   Set OldWkbook = ActiveWorkbook   '   'ファイル名を取得   BkName = OldWkbook.Sheets(StName1).Range("A1").Value   FileName = BkName & Format(Now, "yyyy-mm") & ".XLS"   '   FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName)   If FileName = "" Then     Exit Sub   Else     If Right(FileName, 4) <> ".XLS" Then       MsgBox "ファイル名が異常です。"       Exit Sub     End If   End If   '   OldWkbook.Sheets(Array(StName1)).Copy   Set NewWkbook = ActiveWorkbook   For wIx = 1 To NewWkbook.Sheets(1).Shapes.Count     NewWkbook.Sheets(1).Shapes(wIx).Delete    Next   NewWkbook.Sheets(1).Name = StName1   '   FileName = "D:\保存\計画\" & FileName   '   If Dir(FileName) <> "" Then     '##ファイルが既に存在する     If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then       NewWkbook.Close savechanges:=False       '##保存せずに終了       Exit Sub     End If     '##指定ファイル置き換え保存     NewWkbook.SaveAs FileName:=FileName   Else     '##ファイルを新規保存     NewWkbook.SaveAs FileName:=FileName   End If   '   NewWkbook.Close savechanges:=False   Application.DisplayAlerts = True End Sub 教えて下さい!

  • Excel2003のVBAでエクセルファイルとして保存

    こんにちわ。 Excel2003のVBAで、シート1に採点用のフォーマットを作成し、採点ボタンを押したら別の場所(フォルダ)に別のファイル(.xls形式)として採点結果を保存したいと考えています。過去に似たような質問があったのでそれを参考にしたのですが、コードの意味がほとんど分かりません。下記のコードで実行したところ、エラーが出てしまいます。どこが悪いのか教えていただけないでしょうか? エラー箇所は BkName = OldWkbook.Sheets(StName1).Range("K1").Value です。”インデックスが有効範囲にありません”と表示されます。 例)   Dim FileName As String Dim FileExt As String Dim BkName As String Dim OldWkbook As Workbook Dim NewWkbook As Workbook Const StName1 As String = "ko" ' Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName = OldWkbook.Sheets(StName1).Range("K1").Value FileName = BkName & Format(Now, "yyyy-mm") & ".XLS" ' FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".XLS" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If ' OldWkbook.Sheets(Array(StName1)).Copy Set NewWkbook = ActiveWorkbook 'シートの保護を解除 Worksheets("sheet1").Unprotect For wIx = NewWkbook.Sheets(1).Shapes.Count To 1 Step -1 If Left(NewWkbook.Sheets(1).Shapes(wIx).Name, 6) = "Button" Then 'ボタンのみ削除 NewWkbook.Sheets(1).Shapes(wIx).Delete '←1ではなくwIxです End If Next NewWkbook.Sheets(1).Name = StName1 ' FileName = "D:\保存\計画\" & FileName ' If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 Exit Sub End If '##指定ファイル置き換え保存 NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If ' NewWkbook.Close savechanges:=False Application.DisplayAlerts = True End Sub

  • Excel2003VBAでファイルをコピーして指定場所に保存

    こんにちわ。 私は下記のコードで保存場所をCドライブに指定しているのですが、これを保存先が選べるようにするのはどうすれば良いですか? Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName1 = OldWkbook.Sheets(StName1).Range("E1").Value BkName2 = OldWkbook.Sheets(StName1).Range("E2").Value BkName3 = OldWkbook.Sheets(StName1).Range("E3").Value FileName = BkName1 & Format(".") & Format("試験結果") & Format(".") & BkName2 & Format(".") & BkName3 & ".xls" FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".xls" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If 'シートの保護を解除 Worksheets("Sheet1").Unprotect Worksheets("Sheet2").Unprotect Worksheets("Sheet3").Unprotect OldWkbook.Sheets(Array(StName1, StName2, StName3, StName4, StName5)).copy Set NewWkbook = ActiveWorkbook 'ボタンを削除 For wIx = NewWkbook.Sheets(1).Shapes.Count To 1 Step -1 If Left(NewWkbook.Sheets(1).Shapes(wIx).Name, 6) = "Button" Then 'ボタンのみ削除 NewWkbook.Sheets(1).Shapes(wIx).Delete End If Next NewWkbook.Sheets(1).Name = StName1 'コピー先シートの保護 Sheets(1).Protect Sheets(2).Protect Sheets(3).Protect Sheets(4).Protect Sheets(5).Protect FileName = "C:\" & FileName If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 'シートの保護 Worksheets("Sheet1").Protect Worksheets("Sheet2").Protect Worksheets("Sheet3").Protect Exit Sub '##指定ファイル置き換え保存 End If NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If NewWkbook.Close savechanges:=False Application.DisplayAlerts = True 'シートの保護 Worksheets("Sheet1").Protect Worksheets("Sheet2").Protect Worksheets("Sheet3").Protect End Sub

  • EXCELVBAでONEDRIVE上への保管方法 

    EXCEL ファイルの VBAで、 OneDrive上の ファイルを コピーして XLSX および XLS旧フォーマット 両方の 保存形式で ファイルを 保管しようとしています。 WINDOWS8.1 EXCEL2013 を 使用しています。 ONEDRIVE上へ、コピー作成する同名ファイルがなく、 新規のファイルを コピー作成する場合は 『Microsoft Excelは動作を停止しました。』 というエラーが (ファイルをコピー作成していますが)、 出てしまいます。 上書きする場合は エラー がでない模様です。 ' Sub 旧EXCEL形式保管() ' Application.DisplayAlerts = False ' Dim PathName, FileName1, FileName2, FileName3 As String ' PathName = ActiveWorkbook.Path FileName1 = "テスト.xlsx" FileName2 = "テストCOPY旧.xls" FileName3 = "テストCOPY新.xlsx" ' Workbooks.Open Trim(PathName) & "\" & Trim(FileName1) Windows(Trim(FileName1)).Activate ' ActiveWorkbook.SaveAs Filename:=Trim(PathName) & "\" & Trim(FileName3) ActiveWorkbook.Close ' Workbooks.Open Trim(PathName) & "\" & Trim(FileName1) Windows(Trim(FileName1)).Activate ' If Application.Version < 12 Then ActiveWorkbook.SaveAs Filename:=Trim(PathName) & "\" & Trim(FileName2), FileFormat:=xlExcel9795 Else ActiveWorkbook.SaveAs Filename:=Trim(PathName) & "\" & Trim(FileName2), FileFormat:=xlExcel8 End If ' ActiveWorkbook.Close ' End Sub ' より効率的な VBA記述、 エラーへの対処方法 を 教えていただけないでしょうか? よろしく お願いします。

  • VBA 保存

    保存ボタンを作成してファイルに飛ぶように させていますが…どうしてもエラーになります! エラー表示内容> 実行時エラー1004 シートの名前を他のシート、Visual Basicで参照される オブジェクト ライブラリまたは ワークシートと同じ名前に変更することはできません。 下記は実際の記述です。 Private Sub 保存_Click() Dim FileName As String Dim FileExt As String Dim BkName As String Dim OldWkbook As Workbook Dim NewWkbook As Workbook Const StName1 As String = "計画 グラフ" Const StName2 As String = "ケア一覧" ' Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName = OldWkbook.Sheets(StName1).Range("D1").Value FileName = BkName & Format(Now, "yyyy-mm-dd") & ".XLS" ' FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".XLS" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If ' OldWkbook.Sheets(Array(StName1, StName2)).Copy Set NewWkbook = ActiveWorkbook For wIx = 1 To NewWkbook.Sheets(1).Shapes.Count NewWkbook.Sheets(1).Shapes(1).Delete '←シート1のボタンを削除 Next NewWkbook.Sheets(1).Name = StName1 NewWkbook.Sheets(2).Name = StName2 ' FileName = "D:\看護計画保存\" & FileName ' If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 Exit Sub End If '##指定ファイル置き換え保存 NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If ' NewWkbook.Close savechanges:=False Application.DisplayAlerts = True End Sub

  • エクセル マクロの記述(フォルダーの移動、削除)

    現在開いているエクセルのファイルにマクロを記述し、 1 「処理済」というフォルダーに、開いているエクセルファイルを移動して、同じ名前でエクセルを保存する。 2 「CSV」というフォルダーに、開いているエクセルファイルをCSVファイルに変換して名前を「処理.csv」とし保存する。 3 現在開いているエクセルファイルは削除する。 以上の三つの処理をさせようと、以下のようにしましたが、1,2の処理は出来ましたが、3の開いているエクセルファイルが残ってしまいます。 以上三つの処理が一度に出来るマクロの記述を教えて下さい。 よろしくお願いします Sub マクロ() ActiveWorkbook.SaveAs Filename:="C:\処理済\" & ActiveWorkbook.Name ChDir"C:\CSV" ActiveWorkbook.SaveAs Filename:= "C:\CSV\処理.csv" _ , FileFormat:=xlCSV, CreateBackup:=False Application.DisplayAlerts = False If Workbooks.Count = 1 Then Application.Quit Else ActiveWorkbook.Close End If Application.DisplayAlerts = False End Sub

  • ExcelのマクロでCSVファイルを開くと遅いのですが

    ExcelのマクロでCSVファイルを開くと遅いのですが速く開く方法はありますか? 普通にファイル-開くに比べてかなり遅いです。 下記のVBAで記述してあります。 Workbooks.Open Filename:=fname ActiveWorkbook.SaveAs Filename:=fname, FileFormat:=xlCSV, _ CreateBackup:=False ActiveWorkbook.Close savechanges:=False

  • ファイルの別名保存の方法

    こんにちは。 Excelの素人です。blg.を参考に、ファイルの別名保存ボタンを作りましたが、別名保存後うまく終了してくれません。 現象は終了マクロから名前をつけて保存してもファイルが終了しません。もう一度ボタンをクリックするといきなり終了します。 素人の悲しさで、どこを修正すればよいのか悩んでいます。 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 宜しくお願いします。

  • エクセル シートのみ 保存

    過去の質問も参照しましたが 当てはまる物が無くて質問しました! シート上にボタンを作成して クリックするとそのシートのみ 指定するファイルにコピーさせたいです! 下記の部分で何処を変化させればよいのでしょうか? (1)~(2)の部分で困っています。 Private Sub CommandButton1_Click() Dim FileName As String Dim FileExt As String ’(1)の質問!○=の部分をSheets(セルのA1の値をファイル名に入れたいです) FileName = "○"& Format(Now, "yyyy-mm") & ".XLS" '==== FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".XLS" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If '==== FileName = "D:\保存\ケア\計画\" & FileName If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 上書きしますか?", vbOKCancel, "上書きの確認") = vbCancel Then '##保存せずに終了 Exit Sub ElseIf ThisSheets.FullName = FileName Then '##現在開いているファイルと同じなら上書き保存 ThisSheets.Save Else '##指定ファイルを削除した後保存 Kill FileName ThisSheets.SaveCopyAs FileName:=FileName End If Else '##ファイルを新規保存 ThisSheets.SaveCopyAs FileName:=FileName End If ThisSheets.Saved = True End Sub (2)ThisSheets&指定してもう一つだけ  保存先にコピーしたいです!つまり  2つのSheetのみ保存させたいのですが・・  ここからどのようにしたら良いのか  お願いします!教えて下さい。  

  • VBAでシートの保護

    初めまして。 私はWindowsXP、Excel2003のVBAでシートの保護、またそれの解除のコードを組んだのですが、以下のコードでは「○○○と言う名前で保存します。よろしければこのままOKをクリックしてください」の箇所でキャンセルを選択した時に、シートの保護を行いたいのですが、どのようなコードにすればよいてのでしょうか? 例)   Dim FileName As String Dim FileExt As String Dim BkName1 As String Dim BkName2 As String Dim BkName3 As String Dim OldWkbook As Workbook Dim NewWkbook As Workbook Const StName1 As String = "適材適所グラフ" Const StName2 As String = "適材適所回答" Const StName3 As String = "適性検査III回答" Const StName4 As String = "適性検査IIIグラフ" 'シートの保護を解除 Worksheets("適性検査III回答").Unprotect Worksheets("適材適所回答").Unprotect Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName1 = OldWkbook.Sheets(StName3).Range("L1").Value BkName2 = OldWkbook.Sheets(StName3).Range("L2").Value BkName3 = OldWkbook.Sheets(StName3).Range("L3").Value FileName = BkName1 & Format(".") & BkName2 & Format(".") & BkName3 & ".xls" ' FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".xls" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If OldWkbook.Sheets(Array(StName1, StName2, StName3, StName4)).Copy Set NewWkbook = ActiveWorkbook 'ボタンを削除 For wIx = NewWkbook.Sheets(1).Shapes.Count To 1 Step -1 If Left(NewWkbook.Sheets(1).Shapes(wIx).Name, 6) = "Button" Then 'ボタンのみ削除 NewWkbook.Sheets(1).Shapes(wIx).Delete End If Next NewWkbook.Sheets(1).Name = StName1 'コピー先シートの保護 Sheets(1).Protect Sheets(2).Protect Sheets(3).Protect Sheets(4).Protect FileName = "C:\採点結果\" & FileName If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 Exit Sub '##指定ファイル置き換え保存 End If NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If NewWkbook.Close savechanges:=False Application.DisplayAlerts = True 'シートの保護 Worksheets("適性検査III回答").Protect Worksheets("適材適所回答").Protect End Sub

専門家に質問してみよう