GetSaveAsFilenameでフォルダを指定したいのですが?

このQ&Aのポイント
  • マクロ初心者の方がGetSaveAsFilenameを使用してフォルダを指定する方法を教えてください。
  • エクセル2003で作成したファイルをエクセル2007で保存すると拡張子が付かずにエクセルファイルにならない現象が発生します。この問題の解決方法を教えてください。
  • 上記のマクロコードを使用してファイルを保存する時、保存フォルダの指定方法が分からないので、教えてください。
回答を見る
  • ベストアンサー

GetSaveAsFilenameでフォルダを指定したいのですが?

すいません。マクロ初心者です。 (1)以下のプロシージャで保存するときに、フォルダを指定したいのですがどこにフォルダ名を入れたらいいかわかりません。 (2)XPのエクセル2003で作成したのですが、vistaのエクセル2007で使用すると保存時に拡張子.xlsが付かずエクセルファイルになりません。 ご教授ください。 Sub シート保存2() Dim Answer3 Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant Answer3 = MsgBox("本当に保存しますか?", vbYesNo) If Answer3 = vbNo Then MsgBox ("キャンセルしました。") Exit Sub End If Sheets("保存シート").Select Application.CutCopyMode = False Sheets("保存シート").Copy 既定ファイル名 = Range("V7") & ".xls" 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名) If 保存ファイル名 = False Then MsgBox "保存は中止されました。" ActiveWorkbook.Close (False) Else ActiveWorkbook.SaveCopyAs 保存ファイル名 ActiveWorkbook.Close (False) End If End Sub よろしくお願いします。

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

  • ベストアンサー
  • kenpon24
  • ベストアンサー率64% (66/102)
回答No.2

(2)について さっきVista PCを起動して確かめましたが・・・ GetSaveAsFilenameにファイルタイプのフィルターをかければ問題ないと思います。 Application.GetSaveAsFilename(既定ファイル名, "Excel 97-2003ブック, *.xls")

ryonsuke
質問者

お礼

ありがとうございます。 会社に着いたら早速やってみます。

その他の回答 (1)

  • kenpon24
  • ベストアンサー率64% (66/102)
回答No.1

とりあえず(1)について回答します。 GetSaveAsFilenameメソッドでフォルダの位置を指定するには カレントディレクトリの変更 という作業が必要になります chdrive ディレクトリパス 'ドライブのチェンジ chdir ディレクトリパス 'ディレクトリのチェンジ をGetSaveAsFilename以前に記述してください。 ただし・・・chdriveステートメントはネットワークドライブ(\\~)を指定された場合、ドライブの移動ができません。 このマクロを使用する上でそのようなシチュエーションが考えられる場合、win32 APIのSetCurrentDirectory関数を利用することになります。 以上です。

ryonsuke
質問者

お礼

ありがとうございました。 ちょっと難しそうですね。 もう少し勉強してみます。

関連するQ&A

  • OSがVistaのエクセル2007で作ったファイルがXpのエクセル2003で読み取れない

    すいません。教えてください。 Vista PCエクセル2007で保存したファイルが、XP PCエクセル2003で見ると文字化けしてしまうのですが、どこがいけないのか教えてください。 Sub 保存シートの名前を付けて保存() ' シート保存 Macro '***このマクロは見積もり番号と件名を保存ファイル名にし保存します。*** Dim Answer3 Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant Answer3 = MsgBox("本当に保存しますか?", vbYesNo) If Answer3 = vbNo Then MsgBox ("キャンセルしました。") Exit Sub End If Sheets("保存シート").Select Application.CutCopyMode = False Sheets("保存シート").Copy 既定ファイル名 = Range("V7") 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel 97-2003ブック, *.xls") If 保存ファイル名 = False Then MsgBox "保存は中止されました。" ActiveWorkbook.Close (False) Else ActiveWorkbook.SaveCopyAs 保存ファイル名 ActiveWorkbook.Close (False) End If End Sub よろしくお願いします。

  • シートだけを保存したいのですが?

    はじめましてマクロ初心者です。 検索しましたがわからなかったので、質問させていただきます。 保存をキャンセルすると新規ブックができてしまいます。 キャンセルした時に新規ブックを作りたくないのですが、教えてください。 Sub シート保存() Dim Answer3 Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant Answer3 = MsgBox("本当に保存しますか?", vbYesNo) If Answer3 = vbYes Then Sheets("保存シート").Select Application.CutCopyMode = False Sheets("保存シート").Copy Else MsgBox ("キャンセルしました。") End If 既定ファイル名 = Range("V8") 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名) If 保存ファイル名 = False Then MsgBox "保存は中止されました。" Else ActiveWorkbook.SaveCopyAs 保存ファイル名 End If End Sub よろしくお願いします。

  • VBAでも新規ファイル作成

    Excel2003です。 下記のコードであるシートを別ファイルにして保存するコードを書いています。ただ、このコードでは、コピー元のシートにExcel関数が入っているために、出来上がった新規ファイルを開くときに常に”リンクの更新”を聞かれてしまいます。リンクの更新をする必要はないのでファイルを開くたびに”更新しない”を選択してもよいのですが、初めからこの”リンクの更新”メッセージが出ないようにするには何か良い手立てはないでしょうか? ------------------------------------------------------------- Sub ファイル作成() '報告書を"名前を付けて保存" Sheets("Sheet1").Select Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant 既定ファイル名 = "新規報告書" 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls") If 保存ファイル名 = False Then MsgBox "保存は中止されました。" Sheets("Sheet1").Select Else With ThisWorkbook.ActiveSheet Workbooks.Add .Copy After:=ActiveWorkbook.Sheets(1) Application.DisplayAlerts = False ActiveWorkbook.Sheets(1).Delete Application.DisplayAlerts = True ActiveWorkbook.SaveAs 保存ファイル名, xlNormal ActiveWorkbook.Close False End With Sheets("Sheet1").Select End If End Sub ---------------------------------------------------------------

  • (VBA)特定のシートのみを名前を付けて保存

    Excel2003です。 数シートあるうちの特定のシートのみを別のbookとして「名前を付けて保存」する下記のコードを書きました。一応うまく動くのですが、実はこの特定のシートには行の非表示部分があります。しかし、下記のコードではもちろん非表示部分も開かれた状態で保存がされますよね。 この非表示の状態で保存するにはどのようにすればよいのでしょうか? 【以下現在のコードです】 ------------------------------------------------ Sub 名前を付けて保存() '報告書を"名前を付けて保存" Sheets("報告書").Select Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant 既定ファイル名 = "報告書" 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls") If 保存ファイル名 = False Then MsgBox "保存は中止されました。" Else With ThisWorkbook.ActiveSheet Workbooks.Add .Cells.Copy ActiveSheet.Range("A1") ActiveWorkbook.SaveAs 保存ファイル名, xlNormal ActiveWorkbook.Close False End With Sheets("報告書").Select Range("A1").Select MsgBox "報告書を作成しました。" End If End Sub ----------------------------------------------------

  • エクセル 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 教えて下さい!

  • 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

  • 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

  • 保存場所を指定する(VBA)

    エクセルでVBAを使用し、業務書類を作っていますが、 書類を保存する際に、指定場所に自動で保存させたいと思っています。 現在使用しているものは、下記の通りですが、 これでは、元ファイルと同じ場所に保存されてしまうので 元ファイルを削除されてしまうなどの恐れがあります。 そこで、フォルダを作りそのフォルダに自動的に保存したいと 思っています。フォルダは元ファイルがある下に作りたいと思います。 宜しくお願いします。 下記現在のものです。 Sub 保存() タイトル = "確認" メッセージ = "ファイルを保存します。よろしいですか?" スタイル = vbYesNo + vbQuestion + vbDefaultButton1 + vbApplicationModal yesno = MsgBox(メッセージ, スタイル, タイトル) If yesno = vbYes Then Sheets("新築").Select パス = ActiveWorkbook.Path 別名 = Application.InputBox(prompt:="拡張子(.xls)は不要です", _ Title:="保存用のブック名を入力してください", Type:=2) ' 別名 = パス & "\" & 別名 & ".xls" Sheets(Array("見積新築")).Copy ActiveWindow.DisplayWorkbookTabs = False ActiveWorkbook.SaveAs Filename:=別名 ActiveWorkbook.Close MsgBox "書類を保存しました。", vbInformation, "保存完了" End If End Sub

  • エクセルのハイパーリンクで

    いつもお世話になります。 昨日、エクセルで、あるマスターブック内のシートのコピーをサブブックにコピーし、マスターブックの一覧内にハイパーリンクで繋ぐというものを作成しましたが、このリンクだと、一覧内に書き込まれるハイパーリンクはフルアドレスの書き込みなります。 これを、ダイアログにて保存先、保存名をきいて保存したのちに、ハイパーリンク用として一覧に書き込むファイル名を聞いてくるようにしたいと思います。 昨日作ったモジュールは下記の通りです。 Sub Macro2() Dim strFile As String Dim i As Long Dim na As String Sheets(Array("シート1", "シート2", "シート3", "シート4")).Copy strFile = Application.GetSaveAsFilename(fileFilter:="エクセル ファイル (*.xls), *.xls") If strFile = "False" Then Exit Sub ActiveWorkbook.SaveAs strFile ActiveWorkbook.Close Sheets("一覧").Activate ActiveSheet.Hyperlinks.Add Anchor:=Range("B65536").End(xlUp).Offset(1), Address:=strFile, TextToDisplay:=strFile 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

専門家に質問してみよう