• ベストアンサー

エクセルVBAでブックを相対パスで保存する

お世話になります。 苦労しながらもエクセルVBAをいじっています。仕事の効率を上げるために、VBAで自動化をしていますが、わからないことがありますので教えてください。 月ごとのシートを作成して、その月に完成させたプロジェクトのリストを入力するブックを作り、各契約者に配りたいと思っています。そのブックには、報告書提出を簡素化できるように、作成したい該当月のシートだけを抽出して決められた名前で保存し、電子メールに添付して送信できる状態にした報告書作成のプログラムを組んでいます。が、抽出されたシートだけのブックを、オリジナルのブックがあるフォルダと同じところに保存したいんです。"名前を付けて保存"をVBAに設定すると、絶対パスが必要な要ですし、もしも指定しなければ作業フォルダ(カレントフォルダ)に保存されるようですが、何とかしてオリジナルのブックと同じフォルダに保管できないものでしょうか。 どうぞよろしくお願いします。 ちなみに、下記が自分なりにやってみたものです。 --------------------------------- Private Sub CommandButton1_Click() Dim myName As String Dim pasu As String With ListBox1 If (.ListIndex = -1) Then MsgBox "提出用報告書を作成するシートを選択してください" Else Worksheets(.List(.ListIndex)).Select pasu = ActiveWorkbook.Path ActiveSheet.Copy myName = ActiveSheet.Name ActiveWorkbook.SaveAs Filename:= _ "" & myName & "" & Application.UserName & ".xls" _ , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False Unload UserForm2 End If End With End Sub

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

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.3

こんにちは。 ChDir も一つの考え方かもしれませんが、 シート１つのブックが出来上がって、そのActiveWorkbookと同じ場所に保存するなら、作ったpasu を加えればよいのではありませんか？ 　　pasu = ActiveWorkbook.Path 　　ActiveSheet.Copy 　　myName = ActiveSheet.Name 　　Fname = pasu & "\" & myName & Application.UserName & ".xls" ActiveWorkbook.SaveAs Filename:= Fname, _ 　　　　 FileFormat:=xlNormal, _ 　　　　 Password:="", _ 　　　　 WriteResPassword:="", _ 　　　　 ReadOnlyRecommended:=False, _ 　　　　 CreateBackup:=False それから、なるべく、コードは見やすいように整列して書くことが上達の早道と言われています。 なお、読み違えていましたら、申し訳ありません。

gucci1
質問者

お礼

どうもありがとうございました。おかげさまで解決です。本当に助かりました。またよろしくお願いします。

その他の回答 (4)

  • OsieteG00
  • ベストアンサー率35% (777/2173)
回答No.5

半角スペースは詰められるんですよね＞整列 なお、各パスを返すプロパティはルートディレクトリだと最後に"\"が入りますので考慮が必要です。そうでないとパス名で終わって、"\"は入らないんですけどね。

  • KenKen_SP
  • ベストアンサー率62% (785/1258)
回答No.4

こんにちは。KenKen_SP です。 > オリジナルのブックと同じフォルダ このオリジナルというのが、何なのかよく分からないのですが、 ThisWorkbook.Path でコードが記載されたブックのパスが返ります。 ActiveWorkbook.Path は現在アクティブになっているブックの パスが返されます。 このどちらかで対応できませんか?

gucci1
質問者

お礼

どうもありがとうございました。初心者なもので、わかりにくいこともあったかと思いますが、親切に教えていただきまして、ありがとうございました。

  • OsieteG00
  • ベストアンサー率35% (777/2173)
回答No.2

今、環境が手元に無いので未検証ですが^^ '参考URLより phn = ActiveWorkbook.Path dva = Left(phn, 2) dra = Mid(phn, 3) ChDrive dva ChDir dra '質問文より ActiveWorkbook.SaveAs Filename:= _ "" & myName & "" & Application.UserName & ".xls" _ , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False Unload UserForm2

参考URL：
http://www2s.biglobe.ne.jp/~iryo/vba/VBA14.html#no1414
  • OsieteG00
  • ベストアンサー率35% (777/2173)
回答No.1

カレントフォルダを変更してはどうでしょうか？ ActiveWorkbook.Pathからドライブ名とパス名をそれぞれ拾って、ChDrive と　ChDir　で変更すればよいのでは？ 必要なら、変更前のカレントフォルダ(作業フォルダ)を保存しておいて、VBA終了時に元に戻してはどうでしょうか？

参考URL：
http://www2s.biglobe.ne.jp/~iryo/vba/VBA14.html#no1414
gucci1
質問者

お礼

いろいろお手数をおかけして、申し訳ありませんでした。本当に助かりました。またよろしくお願いします。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • ブックＣｌｏｓｅでＶＢＡが続かない

    エクセル２００２を使用しています ブック（Ａ）をコピーして名前（Ｂ）をつけて別ブックで保存しました ブック（Ａ）を呼び出し後、ブック（Ｂ）を閉じてブック（Ａ）のＶＢＡを継続したいのですが 継続しません 作成したモジュールは以下です 　　Application.DisplayAlerts = False 　　'【不要なシートを削除する】 Sheets(Array("注文書入手差異表", "入手予定履歴", "main", "営C")).Select ActiveWindow.SelectedSheets.Delete 　　'【ThisWorkbook.Pathの『注文書確認フォルダ』の中に、名前をつけて別ブックで保存する 　　'　　　…ユーザーフォームを使用するのでマクロごと保存】 Dim myFolder As String Dim Filename As String myFolder = ThisWorkbook.Path & "\注文書確認フォルダ" Filename = Format(Date, "yyyymmdd") & "注文書入手予定表" If Dir$(myFolder, vbDirectory) = "" Then MkDir myFolder End If ActiveWorkbook.SaveAs Filename:= _ myFolder & "\" & Filename Application.DisplayAlerts = True '【保存した別ブック名を再取得】 Dim myName0 As String myName0 = ThisWorkbook.Name 　　'【コピー元のファイルを開く】 Dim myPath As String myPath = Application.Substitute(ThisWorkbook.Path, "\注文書確認フォルダ", "") Workbooks.Open (myPath & "\" & "注文書入手予定表") 　　MsgBox "【注文書確認フォルダ】の中に別ブックが作成されました" 　 　　'【保存した別ブックを閉じる】 Workbooks(myName0).Activate Windows(myName0).Activate ActiveWorkbook.Close '******下のマクロが続かない***************** '====================== Call Macro6 '====================== 　　VBA ステップインで原因を探ろうとしたのでですが 　　「中断モードでは入力できません」のメッセージがでて 　　デバッグができません 　　八方ふさがりの状態です。助けていただけませんか。

  • ExcelのVBAでブックの保存

    ExcelのVBAでブックを追加し保存を行っています。 その際、保存は、どこに行うのがよいのですか bookですか。sheetですか。 両方で、SaveAsができまが、使い分けがあるのでしょうか。 どのように使い分けするのでしょうか。 Workbooks.Add ActiveSheet.Name = "サンプル" ActiveSheet.SaveAs OutFileName ActiveWorkbook.SaveAs OutFileName ActiveWorkbook.Close

  • （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 ----------------------------------------------------

  • Excelシート１シートのみを指定フォルダへ保存

    Excelのシート1のみを、本日の日付と名前の入ったセル（I7）を保存する時の名前にして指定したフォルダへ保存したいと思っています。 1、シートは本日の日付+I7セルに入っている値を名前にする。 2、フォルダはCではなくV:\○○\○○\○○\○○\○○\○○\○○に格納 3、シート1以外のシート2、シート3は保存せず閉じる 4、格納後○○に保存しました。と表示 試行錯誤し、下記のように記述してみたのですが、 Sub Macro1() 'Option Explicit Sub Sample() Dim xSheet As Worksheet Dim myFile As String Dim myName As String Set xSheet = ActiveSheet ThisWorkbook.Worksheets("シート名").Copy 'myName = ActiveWorkbook.Worksheets(1).Name 'myFile = ThisWorkbook.Path & "\" & myName & ".xls" myFile = ThisWorkbook.Path & "\" & xSheet.Range("I7").Value & ".xls" Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=myFile Application.DisplayAlerts = True ActiveWorkbook.Close End Sub 日付を指定して保存 Sub test() 　Dim Filename As String 　Filename = Format(Date, "yyyy年mm月dd日") & ".xls" 　ActiveWorkbook.SaveAs "C:\My Documents\" & Filename End Sub 日付とI7セルの名前を合せてブックの名前としたい場合どうVBEで記述すればいいのかわからないので詳しい方がおられましたら、 よろしくお願いいたします。 あまり詳しくないので、そのままコピーできるか、○○の部分を指定フォルダ名に変えてください。等の注釈を付けていただけると助かります。

  • VBAでブック名の拡張子を除去してシートにコピー

    VBA初心者でコード作成で困っております。 下記の通りコードを組みましたが、シート名をブック名に変更して 保存したいのですが、このコードですと拡張子までついてしまいます。 拡張子を除去するためにはどうすればよいでしょうか？ アドバイス宜しくお願い致します。 Sub test() 'シート名の変更 Dim MyPath As String Dim MyFile As String Dim Wb As Workbook MyPath = "C:\TEST\" MyFile = Dir(MyPath & "*.xlsx") Do While MyFile <> "" Set Wb = Workbooks.Open(MyPath & MyFile) ActiveSheet.Name = ActiveWorkbook.Name Application.DisplayAlerts = False Wb.Save Application.DisplayAlerts = True Wb.Close (False) MyFile = Dir() Loop End Sub

  • VBA コピペの途中でエラーになってしまいます。

    以前、質問させて頂き、マクロでしたい事の記述方法を教えて頂きました。 ご教示頂いたマクロ記述に更に手を加えて、下記のように記述しました。 したいことは、一つのフォルダにExcel Bookが１２０ほどあり、その中のマクロを組んだ集計用Book以外のBookから同じ名前のシート”結果”をコピーして、コピペされたシートは１、２、３・・という名前にして集計用Bookに値貼り付けをする。。というものです。 ところが、下記のマクロを実行するとシート名25までコピペされるのですが、途中で ”問題が発生したため MICROSOFT OFFICE EXCELを 終了します。・・・・・”　とエラーになってしまいます。 このエラーを回避して120ほどあるシートをマクロのある集計Bookへコピペするには、どのようにしたら良いでしょうか？ ご存知の方がみえたら、ご教示下さい。宜しくお願いいたします。 ＜マクロの記述＞ Sub macro() Const Aフォルダ As String = "C:\Documents and Settings\Bic\デスクトップ\Aフォルダ\" Dim FileCounter As Integer Dim myName As String myName = Dir(Aフォルダ & "*.xls") FileCounter = 0 Application.ScreenUpdating = False Do While myName <> "" If myName <> ThisWorkbook.Name Then Application.DisplayAlerts = False Workbooks.Open Aフォルダ & myName On Error Resume Next Workbooks(myName).Worksheets("結果").Copy After:=ThisWorkbook.Worksheets(2 + FileCounter) If Err.Number = 0 Then ActiveSheet.Range("A1:L35").Copy ActiveSheet.Range("A1:L35").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False FileCounter = FileCounter + 1 ActiveSheet.Name = FileCounter End If On Error GoTo 0 Workbooks(myName).Close End If myName = Dir Application.DisplayAlerts = True Loop Application.ScreenUpdating = True 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 ---------------------------------------------------------------

  • 同じフォルダーに保存したい。

    報告書.xlsを一部加工後に実行するVBマクロで教えてください。同じフォルダー内で報告書.xlsを上書き保存しさらに４個のsheet(報告書、詳細、依頼書、関連写真)の内、２個のsheet(依頼書、関連写真)を削除した後にsheet(報告書)のセル"Z1"の名前で保存すべく作成したのですが(Z1).xlsが同じフォルダーに作成できません。マイドキュメントに出来てしまいます。 Sub Macro2() Dim strFilePath As String Dim strFileName As String Dim flg As Boolean '◆保存するパスの設定 strFilePath = ThisWorkbook.Path & "\" '◆保存するファイル名の指定 Application.DisplayAlerts = False strFileName = "報告書" ThisWorkbook.SaveAs strFilePath & strFileName Sheets("関連写真").Select ActiveWindow.SelectedSheets.Delete Sheets("依頼書").Select ActiveWindow.SelectedSheets.Delete Sheets("報告書").Select strFilePath = ThisWorkbook.Path & "\" Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=ActiveSheet.Range("z1").Value End Sub

  • VBA 開いているブックの場所

    ExcelでVBAを利用して、フォルダ（c:\"VBA練習"）に置いてあるExcleの内容を、開いているExcleに自動読取り作業をするために、下記のようなコードを記述しました。（正常に動作します） そこで、ご相談なのですが、現在は特定のフォルダ（c:\"VBA練習"）にExcelを置かないと読み取りは実現しません。ですが、開いているBookが置いてある"場所"にあるExcelを読み取りたい場合、どのように書き換えれば宜しいでしょうか？ ご教授いただけると助かります。宜しくお願いします。 -------------------------------------------------------------- Private Sub 読込ボタン_Click() Dim myDir As String, myName As String, myBook As Workbook Dim copydata As Range, GYO As Range Dim SH2 As Worksheet, SH1 As Worksheet Set SH2 = ThisWorkbook.Worksheets("情報シート") '集計用のブックがあるフォルダ名を指定 myDir = "C:\VBA練習" myName = Dir(myDir & "\" & "*.xls") Do While myName <> "" Set GYO = SH2.Range("A65536").End(xlUp).Offset(1) '(1)指定した名前のブックを開いて変数に格納する Set myBook = Workbooks.Open(Filename:=myDir & "\" & myName) '(2)転記元を取得する Set SH1 = myBook.Worksheets("回答内容") Set copydata = SH1.Range("Z1").Resize(100, 1) '(3)転記先に貼り付ける copydata.Copy GYO.PasteSpecial Paste:=xlPasteValues, Transpose:=True '(4)開いたブックを閉じる myBook.Close myName = Dir() Loop End Sub --------------------------------------------------------------

  • EXCEL VBA におけるブック終了後の値の保存方法について

    ＥＸＣＥＬ ＶＢＡについて質問があります。もしかしたら初歩的なことかもしれませんがよろしくお願いいたします。 まず、 Sub Test() Dim i As String i = InputBox("好きな果物を入力してください") Sheets("Sheet1").Range("A1").Value = i End Sub を実行し、ブックを保存して終了する。 ブックを開く Private Sub Workbook_Open() Dim k As String k = Sheets("Sheet1").Range("A1").Value If k = "みかん" Then MsgBox ("a") Else: MsgBox ("b") End If End Sub この処理を Sheets("Sheet1").Range("A1").Value = i というシート上のセルに値を保存するという方法を取らずに iの値をブック終了後もプロシージャ内に持っておくというのは可能なのでしょうか。 Publicで宣言してもブックを一度閉じると やっぱりiの値は保存されませんでした。 どうぞよろしくお願いいたします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する