VBA 名前を付けて保存の方法について

前へ 次へ
このQ&Aのポイント
  • VBAのコードにて名前を付けて保存のやり方ができません。現在開いているファイルを名前を付けて保存したいのですがファイルの指定方法が間違っているのか保存できません。
  • 現在開いているファイル内のシート（設定画面）のA1セルとA2セルの文字を指定のドライブに保存したい。名前を付けて保存するためにA1セルとA2セルの文字をくっつけた名前を使用して保存したい。
  • マクロの記録を使用してドライブの名前を指定し、現在開いているファイルを名前を付けて保存しようとしていますが、うまく動作しません。正しい動作するコードを教えていただきたいです。
回答を見る
  • ベストアンサー

VBA 名前を付けて保存の方法について

VBAのコードにて名前を付けて保存のやり方ができません。 現在開いているファイルを 名前を付けて保存したいのですが ファイルの指定方法が間違っているのか保存できません。 やりたいこと 現在開いているファイル内のシート（設定画面）の A1セルとA2セルの文字を "G:￥●エクセル￥ソフト￥計画"のドライブにて 保存する（A１セルとA２のセルの文字をくっつけて名前を付けて保存したい） 例：元のbook1のファイル名をA1セルとA２セルの文字をくっつけた 　　名前にしてから保存したい。 保存先のドライブの指定方法が分からなかったため マクロの記録にてそのドライブへ名前を付けて保存してみて ドライブの名前の指定をしました。（この方法も間違っていますか？） コードを下記に記載しています。 すいませんがうまく動くコードを記載してもらえると 助かります。 回答よろしくお願いします。 Sub macro1() Dim wb As Workbook Dim ws As Worksheet Dim hozonPath As String Dim FolName As String Dim FilName As String Set wb = ThisWorkbook Set ws = Worksheets("設定画面") hozonPath = "G:￥●エクセル￥ソフト￥計画" FolName = ws.Range("A1").Value FilName = ws.Range("A2").Value wb.SaveAs fileName:=hozonPath & FolName & "￥" & FilName End Sub

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

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.2

No.1の補足です。 FolName = ws.Range("A1").Value これはフォルダ名じゃなくてファイル名でいいんですよね。 フォルダ名だとしたら wb.SaveAs fileName:=hozonPath & "￥" & FolName & "￥" & FilName

その他の回答 (2)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

ドライブ名、フォルダ名、ブック名、拡張子を結合演算子＆で結合した直後に 「MSGBOX　（変数名＝結合した文字列の入った）」の行を入れて実行し、その文字列を画面に出し、それをじっくりチェックすれば、分ることで、それさえもやってないのでは。 私は処理途中のコードの中で、確認のため、しつこいぐらいこのやり方を使っている。

  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.1

wb.SaveAs fileName:=hozonPath & "￥" & FolName & FilName じゃないでしょうか。￥は半角の￥ですよね。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • VBA 指定フォルダに複数のセル内容で保存

    こんにちわ。 いつもお世話になっております。 さて、毎度VBAでお世話になっており、表題については指定のシートのみxlsx、pdfファイルで保存するような場合のコードは都度教えていただいて都度うまく行っていたのですが、フォルダやファイルの種類を変えるとうまく行かない場合が多く、試行錯誤で何とかしていたので須が、今回どうしてもあれとこれとを組み合わせてもうまく行かず。 今回の目的で使えそうなpdfでの保存コードは何故かコード中の「pdf」を「xlms」に変更してもpdfファイルで保存されてしまうのは理解できず。 そこでNETで調べたら当方にも分かり易い汎用の下記のサンプルコードがあったのですが ＞ 'ドライブ等の名前を変数に ＞ hozonPath = "K:\" のドライブの書式 ”K:\” が良くわかりません。 具体的に "\\Srv01\業務g\応援チーム\MyPicture" このフォルダに保存したいのですが、どう記載するのか教えてください。 ファイル名にしたいセルは単にA1、A2というように単にセルの列行の記載すればいいのですよね? あまりに初歩的過ぎて質問の意味が分かりにくいでしょうか? Sub hozon() Dim wb As Workbook 'ワークブック Dim ws As Worksheet 'ワークシート Dim hozonPath As String 'ドライブ等のパス用 Dim FolName As String 'A1セル用のフォルダ名用 Dim FilName As String 'A2セル用のファイル名用 '自ワークブック Set wb = ThisWorkbook 'アクティブシート Set ws = ActiveSheet 'ドライブ等の名前を変数に hozonPath = "K:\" 'A1セルの値を変数に FolName = ws.Range("A1").Value 'A2セルの値を変数に FilName = ws.Range("A2").Value wb.SaveAs Filename:=hozonPath & FolName & "\" & FilName End Sub

  • エクセルVBAでファイル作成

    エクセルVBAで、データをフィルタで抽出し、別なBOOKの指定シートに転記し、名前をつけて保存したいのです。一応、下記のコードでテストは成功しました。 しかし下記コードでは1回ごとにデータの転記先を開かなくてはなりません。 処理する件数が多いので、できればいちいち新たに開き直さなくともよい方法はないでしょうか？ 最初から開いておいて、転記後名前をつけて保存すると、開いていたファイルが閉じてしまい、うまくいきません。 別BOOKでなく別シートに転記して、そのシートをMoveして別ファイル保存ならわかるのですが、今回はどうしても別BOOKに転記しなければなりません。 よろしくお願いします。 Option Explicit Sub データ分割転記() 　　Dim myPth As String, fname As String 　　Dim myRng As Range, myC As Range 　　Dim i As Long, x As Long 　　Dim wb(2) As Workbook 　　Dim ws As Worksheet 　　Dim t As Single 　　t = Timer 　　Set wb(0) = ThisWorkbook 　　myPth = wb(0).Path 　　With wb(0).Sheets("Key") 　　　　Set myRng = .Range("A2", .Range("A2").End(xlDown)) 'KeyData 　　End With 　　 　　For Each myC In myRng 　　　　Application.EnableEvents = False 　　　　Set wb(1) = Workbooks.Open(Filename:=myPth & "\20150806TEST.xlsm") 　　　　Set ws = wb(1).Sheets("List") 　　 　　　　With wb(0).Sheets("DATA") 　　　　　　.Range("A1:J1").AutoFilter Field:=4, Criteria1:=myC.Value 　　　　　　.Range("A2", .Range("A2").SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy ws.Range("A9") 　　　　　　.ShowAllData 　　　　End With 　　　　With ws 　　　　　　x = .Cells(Rows.Count, "A").End(xlUp).Row 　　　　　　myC.Offset(, 2).Value = x　'行数確認 　　　　　　.Range("A9").Value = 1 　　　　　　If x > 9 Then 　　　　　　　　.Range("A9").AutoFill Destination:=.Range("A9:A" & x), Type:=xlFillSeries '連番 　　　　　　End If 　　　　End With 　　　　wb(1).SaveAs Filename:=myPth & "\作成ファイル\" & myC.Value & ".xlsm" 　　　　wb(1).Close (False) 　　　　Application.EnableEvents = True 　　　　i = i + 1 　　Next 　　MsgBox i & "件を完了" _ 　　& vbCrLf & Timer - t & " Sec." End Sub ＊Application.EnableEvents = False を使っているのば別BOOKが持つイベントマクロを作動させないためです。

  • 指定したセルでファイル名を保存するマクロについて

    マクロ初心者です。 A1セルの文字をファイル名にして保存する方法を知りましたが、A1セルとB１セルの文字をファイル名にして保存したい場合、どのようにすれば良いか分かりません。 A1セルに企業コード、B1セルに企業名です。 ファイル名を「請求書（13579いろは株式会社様）」としたいのです。 実際のマクロを一部抜粋しますが、下記の場合はファイル名は 「請求書（13579様）.xls」となります。 Dim WS As Worksheet Dim fname As String fname = "C:\保存先\" & ("請求書(") & WS.Range("a1").Value & ("様)") & ".xls" どなたか教えて下さい。 どうぞよろしくお願い致します。

  • エクセルVBAのエラー

    よろしくお願いします。 VBA初心者のものです。 下記のコードを作成しましたが、 アプリケーション定義?がされていません というエラーが出ます。 わかりやすく教えていただけないでしょうか。 修正方法を教えてください。 0901名簿.xlsという名前の ファイルAのsheet1の 情報（ファイルBのセルBD1に日付4桁が記入されている）を ファイルBのセルA1の情報を元にファイルBのセルB１に抽出したい Sub 関数の挿入() Dim i As Long Dim あ As String Dim い As String Dim う As String あ="=VLOOKUP(A1,[" い=Range("BD1") う="名簿.xls]Sheet1!$F:$I,1,0)" For i = 2 To 50 Range("A" & i )= あ & い & う Next i End Sub

  • VBAが止まります。

    フォルダ内の全てのエクセルデータを一つにまとめたいのですが、 下記を実行すると、添付ファイルのメッセージが出て先に進みません。 調べましたがよくわかりませんので、ご教示いただけませんでしょうか。 画像の最上部の『'プログラム0｜変数設定の指定Option Explicit』が欄外に はみだしていて直せません、こちらが原因でしょうか。 ------------------------------------------------------- 'プログラム1｜プログラム開始 Sub GetExcelDataInFolder() 'プログラム2｜シート設定 Dim ws1 As Worksheet Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'プログラム3｜FileSystemObjectの設定 Dim fs As FileSystemObject Set fs = New FileSystemObject 'プログラム4｜対象フォルダを取得 Dim myfolder As Folder Set myfolder = fs.GetFolder(ThisWorkbook.Path) 'プログラム5｜対象フォルダ内の全ファイルを処理 Dim myfile As File For Each myfile In myfolder.Files 'プログラム6｜拡張子が「xlsx」のファイルのみを処理 If fs.GetExtensionName(myfile) = "xlsx" Then 'プログラム7｜フォルダ内のエクセルを開いてシートを設定 Dim wb As Workbook Set wb = Workbooks.Open(Filename:=myfile) Dim ws2 As Worksheet Set ws2 = wb.Worksheets(1) 'プログラム8｜開いたエクセルの最終行を取得 Dim cmax As Long cmax = ws2.Range("A65536").End(xlUp).Row Debug.Print myfile.Name & "のcmax=" & cmax 'プログラム9｜開いたエクセルのデータを転記 Dim i As Long For i = 2 To cmax Dim cmax1 As Long cmax1 = ws1.Range("A65536").End(xlUp).Row ws1.Range("A" & cmax1 + 1 & ":E" & cmax1 + 1).Value = ws2.Range("A" & i & ":E" & i).Value Next 'プログラム10｜エクセルを閉じる wb.Close 'プログラム11｜オブジェクト解放 Set ws2 = Nothing Set wb = Nothing End If Next 'プログラム12｜エクセルを保存 ThisWorkbook.Save 'プログラム13｜オブジェクト解放 Set myfolder = Nothing Set fs = Nothing 'プログラム14｜プログラム終了

  • エクセルVBAでファイル保存失敗の原因？

    エクセル2010です。 Sheets("DATA")にある822件のデータを、D列のデータ（担当者名）をキーにフィルター抽出し、雛形のシートにコピーして、そのシートを別ファイルとして名前をつけて、指定したフォルダーのサブフォルダに保存するマクロです。（サブフォルダ名はデータのG列にある文字列です。） キーとなる担当の数は223です。 以下のコードで一応作動するのですが、同じデータを使っても2回に一回くらいの割合で保存ができず、 wb(1).SaveAs Filename:=SaveDir & "\" & bcde & "_" & Trim(myC.Value) & ".xlsx" のところで止まってしまいます。 エラーは 「実行時エラー1004 SaveAsメソッドは失敗しました。Workbookオブジェクト」 というものです。このとき、画面上ではあたらしいファイルが出来あがっております。しかしその出来てるファイルを手動で保存しようと思っても、 「○○○（ファイル名）は保存中にエラーが検出されました。いくつかの機能を削除または修復することによりファイルを保存できる場合があります」 とでてしまいます。 まだテスト段階で、同一のデータでテストしているのですが、止まるデータは30件目であったり、140件目であったり、まちまちです。2回に1回くらいは最後まで動き、すべて正しく作成され保存できているので、データの問題ではないと思います。 ほかにどんな問題が考えられるのでしょうか？とても困っています。 Sub TEST20151114() 　　Dim SaveDir As String, bcde As String, sbfdr As String 　　Dim wb(1) As Workbook 　　Dim i As Long, x As Long 　　Dim myRng As Range, myC As Range 　　Dim t 　　 　　t = Time 　　 　　Set wb(0) = ThisWorkbook 　　Set myRng = wb(0).Sheets("担当別").Range("B2：B224") 　　Application.ScreenUpdating = False 　　For Each myC In myRng 　　　　wb(0).Sheets("回答雛型").Copy After:=wb(0).Sheets("回答雛型") 　　　　wb(0).Sheets("回答雛型 (2)").Name = "回答シート" 　　　　With wb(0).Sheets("DATA") 　　　　　　.AutoFilterMode = False 　　　　　　.Range("A1:J1").AutoFilter 　　　　　　.Range("A1:J1").AutoFilter Field:=4, Criteria1:=myC.Value 'D列 　　　　　　.Range("A2", .Range("A2").SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy Sheets("回答シート").Range("A2") 　　　　　　.ShowAllData 　　　　　　x = wb(0).Sheets("回答シート").Cells(Rows.Count, "A").End(xlUp).Row 　　　　　　.Range("A823:J827").Copy wb(0).Sheets("回答シート").Range("A" & x + 1) '予備5行追加 　　　　End With 　　　　 　　　　With wb(0).Sheets("回答シート") 　　　　　　.Rows(x + 6 & ":" & .Rows.Count).Delete Shift:=xlUp 　　　　　　Application.Goto Reference:=.Range("A1"), Scroll:=True 　　　　　　bcde = CStr(Trim(.Range("E2").Value)) 　　　　　　sbfdr = Trim(.Range("G2").Value) 'サブフォルダ名 　　　　　　 　　　　　　.Move 　　　　End With 　　　　 　　　　Set wb(1) = ActiveWorkbook 　　　　 　　　　SaveDir = wb(0).Path & "\20151114\" & sbfdr '保存先 　　　　If Dir(SaveDir, vbDirectory) = "" Then 　　　　　　MkDir SaveDir '無ければサブフォルダ作成 　　　　End If 　　　　 　　　　DoEvents 　　　　 　　　　wb(1).SaveAs Filename:=SaveDir & "\" & bcde & "_" & Trim(myC.Value) & ".xlsx" 　　　　wb(1).Close (False) 　　　　myC.Offset(, 1).Value = x - 1 　　　　 　　　　i = i + 1 　　　　Application.StatusBar = i & "/" & myC.Value 　　　　Set wb(1) = Nothing 　　Next myC 　　 　　Set wb(0) = Nothing 　　Application.ScreenUpdating = True 　　MsgBox i & "個のファイルを作成しました。" & vbCrLf & Format(Time - t, "hh:mm:ss") 　　Application.StatusBar = "" End Sub

  • VBAを使って名前をつけて保存をしたい(2)

    Sub 名前を付けて保存() Dim wSeq As String Dim wStr As String Dim Flnm As String Dim wFlnm As String ' Sheets("データー").Select Range("C3").Select ActiveWorkbook.Save Flnm = "\\Jooo\センタ\AA\CC" & Format(Date, "【mmdd】") & ".xls" If Flnm = "False" Then Exit Sub End If ' wSeq = 0 ExitFlg = False wFlnm = Flnm Do While ExitFlg = False If Dir(Flnm) <> "" Then '存在したら、連番を加算 wSeq = wSeq + 1 wStr = "(" & wSeq & ")" Flnm = Left(wFlnm, Len(wFlnm) - 4) & wStr & ".xls" Else '存在しない時、保存 ActiveWorkbook.SaveAs Filename:=Flnm ExitFlg = True End If Loop End Sub 先日回答者の方から上記コードを教えてもらい助かっているんですが、少し不都合でてきまして、上記を実行すると最初にCC【1022】という名前でフォルダに保存され、二回目に実行するとCC【1022】(1)という名前で同じフォルダに保存され、三回目に実行するとCC【1022】(2)というように連番で同じフォルダに保存されるんですが、一番最初に保存されたCC【1022】を削除して(どんどんBookが溜まっていくのを防ぐ為)四回目に実行すると【1022】(3)ではなく最初のCC【1022】の名前で保存されてしまいます。【1022】を削除してもCC【1022】(3)で保存されるようにするには、コードをどの様にかえたらいいでしょうか?

  • （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のVBAについて(勉強中のです。)

    ExcelのVBAについて(勉強中のです。) ここからコード3以降に入力したコードを抜き出してデータ表を作成しそれを保存するコードを作成したいです。例えばCSV形式にするとか？ データ表は1日分の表示で、保存して週間や月間または統計データまでを視野にいれています。今回は保存する所です。。 利用しやすい状態と保存形式で、よろしくお願いします。データは生活記録みたいなものです。何したどうしたどうなった？ ※大分分岐する予定で、作成中であり、今回はコードの整理は不要です。 '///Sheet1/// Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim time7 As Range For Each time7 In Target If time7.Column = 1 Then time7.Offset(0, 4).Value = Format(Now, "Short Time") & vbCrLf & _ Format(Now, "yyyy/mm/dd hh:nn:ss AM/PM") End If Application.EnableEvents = False Application.EnableEvents = True Next time7 '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 ws2.Range("A3:H3").Value = ws1.Range("A3:H3 ").Value End Sub Private Sub Worksheet_Activate() ' ' 新規行挿入 ' ' Worksheets("Sheet2").Range("3:3").Insert Sheets("Sheet1").Range("H3").Select ActiveCell.FormulaR1C1 = "5" Sheets("Sheet1").Range("E3").Select Selection.ClearContents Dim str_Left As String 'セルE4に文字列、セルH4に数字を予め入れておくこと。 str_Left = Left(Cells(4, 5), Cells(4, 8)) MsgBox str_Left & vbCrLf & " " & "OKボタンを押してください!" Sheets("Sheet1").Range("A3").Select Dim se_r As String se_r = Application.InputBox("バーコードを入力してください") Select Case se_r Case "False" MsgBox "キャンセルされました" Case "" MsgBox "空欄が入力されました" Case Else Range("A3").Value = se_r End Select End Sub ' ///Sheet2/// Private Sub Worksheet_Activate() Dim Emp(1 To 300) As String Dim msg As String Dim i, i2, Cnt As Integer Dim N_In As Variant For i = 3 To 3 If IsEmpty(Cells(i, 1).Value) = False Then 'ここで空欄判定 Worksheets("Sheet1").Range("3:3").Insert '対象セルアドレスを改行処理 End If Next i '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") ws1.Activate End Sub

  • エクセルVBAで読み取りパスワード回避

    エクセル2010です。 以下のコードで任意のフォルダ内のエクセルBOOKから所定のデータを取得できます。 しかし、指定フォルダ内に読み取りパスワードが設定されたものがあると、開くことができずに止まってしまいます。 読み取りパスワードが同一で、事前に分かっていればコードにPassword:="AAAABBBB"　などと書き入れればいいと思うのですが、事前にはわかりませんし、パスワードもそれぞれ異なります。 そこで、開けなかった場合には、そのBOOKを飛ばしてすすみ、別シートに飛ばしたBOOK名を記録しておきたいのです。 （BOOK作成者にあとからパスワードを聞くため） しかし、残念ながらどのように書けばいいのか思いつきません。 ご指導いただければ幸いです。 Sub TEST001() 　　Dim wb(1) As Workbook 　　Dim ws(1) As Worksheet 　　Dim myFdr As String, fn As String 　　Dim i As Long 　　With Application.FileDialog(msoFileDialogFolderPicker) 'フォルダ指定 　　　　If .Show = True Then 　　　　　　 myFdr = .SelectedItems(1) 　　　　Else 　　　　　　Exit Sub 　　　　End If 　　End With 　　Application.ScreenUpdating = False '画面更新を一時停止 　　Set wb(0) = ThisWorkbook 'このコピー先ブックをwb(0)とする。 　　Set ws(0) = wb(0).Sheets(1) 'wb(0)の１枚目のシートをws(0)とする。 　　fn = Dir(myFdr & "\*.xls*") 'フォルダ内のExcelブックを検索 　　Do Until fn = Empty '全て検索 　　　　Application.EnableEvents = False 　　　　Set wb(1) = Workbooks.Open(myFdr & "\" & fn, UpdateLinks:=False, ReadOnly:=True) 'そのブックを開きwb(1)とする。 　　　　Set ws(1) = wb(1).Worksheets(1) 　　　　i = i + 1 　　　　ws(0).Cells(i, "A").Value = ws(1).Range("B2") 'ws(0)に転記 　　　　ws(0).Cells(i, "B").Value = wb(1).Name 　　　　ws(0).Cells(i, "C").Value = ws(1).Name 　　　　wb(1).Close (False) '保存せず閉じる 　　　　Application.EnableEvents = True 　　　　fn = Dir 'フォルダ内の次のExcelブックを検索 　　Loop '繰り返す 　　Application.ScreenUpdating = True '画面更新停止を解除 　　MsgBox i & "個取得" End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する