- ベストアンサー
エクセルVBAでブックを相対パスで保存する
Wendy02の回答
こんにちは。 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 それから、なるべく、コードは見やすいように整列して書くことが上達の早道と言われています。 なお、読み違えていましたら、申し訳ありません。
関連する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
- 締切済み
- その他MS Office製品
- （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で記述すればいいのかわからないので詳しい方がおられましたら、 よろしくお願いいたします。 あまり詳しくないので、そのままコピーできるか、○○の部分を指定フォルダ名に変えてください。等の注釈を付けていただけると助かります。
- 締切済み
- Excel（エクセル）
- 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
- ベストアンサー
- SE・インフラ・Webエンジニア
- 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
- ベストアンサー
- Visual Basic
- 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 --------------------------------------------------------------
- ベストアンサー
- Visual Basic
- ExcelのVBAでブックを保存
住所録Aと住所録Bがあります。 AとBを比較して、差異をを別ファイルに出力しようとしています。 比較元となるファイルは、AでもBでもかまいません。 比較、判定、ファイルへの出力部分は、省略していますが、保存 する場合は、どこに行うのがよいのですか bookですか。sheetですか。 両方で、SaveAsができまが、使い分けがあるのでしょうか。 どのように使い分けするのでしょうか。 書き方、使い方のおかしいところを指摘して頂くとありがたい です。 --------------------------------------------------------------------------------------------------- Option Explicit Sub test() Dim ret As Integer Dim row1 As Long Dim col1 As Long Dim row2 As Long Dim col2 As Long Dim myRtn As Boolean Dim fno1 As String Dim fno2 As String Dim OutBook As New Workbook Dim OutSheet As New Worksheet Dim OutFileName As String Dim cnt As Integer Dim I As Integer ret = MsgBox("処理を開始します。" + Chr(13) + Chr(10) + "よろしいですか。？", _ vbYesNo + vbQuestion) If ret = vbNo Then End End If myRtn = Application.Dialogs(xlDialogOpen).Show If myRtn = False Then MsgBox "［キャンセル］が選択されました" & vbCr & _ "処理を終了します" Exit Sub End If fno1 = Application.ActiveWorkbook.Name myRtn = Application.Dialogs(xlDialogOpen).Show If myRtn = False Then MsgBox "［キャンセル］が選択されました" & vbCr & _ "処理を終了します" Exit Sub End If fno2 = Application.ActiveWorkbook.Name Set OutBook = Workbooks.Add Set OutSheet = ActiveSheet OutBook.Worksheets(1).Name = "テスト" OutFileName = "テスト.xls" With Application.Workbooks(fno1).Worksheets(1) row1 = 1 col1 = 1 cnt = 1 Do While .Cells(row1, 1) <> "" 処理 （省略） Loop End With MsgBox "処理が終了しました。", vbOKOnly + vbInformation, "確認" Application.Workbooks(fno1).Close Application.Workbooks(fno2).Close OutSheet.SaveAs Filename:=OutFileName OutBook.SaveAs Filename:=OutFileName OutBook.Close End Sub --------------------------------------------------------------------------------------------------- OutSheet.SaveAs Filename:=OutFileName or OutBook.SaveAs Filename:=OutFileName のどちらでも保存ができます。 また、書き方、使い方のおかしいところを指摘して頂くとありがたいです。
- 締切済み
- その他MS Office製品
お礼
どうもありがとうございました。おかげさまで解決です。本当に助かりました。またよろしくお願いします。