[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロ有効ブックでの保存』(暑い)
お世話になります。
フォルダーを選択して,ActiveBookのファイル名に番号を振って「マクロ有効ブック」で保存しようと思い,下記のコードを書きましたが,保存されたフォルダー内をみると「マクロ有効ワークシート」となっています。いままでVBAを使って(保存のコード化をして)保存をさせたことがなく気にしていませんでしたが,普通に保存しているものも確かに「マクロ有効ワークシート」となっています。
(1)気にするようなことでないかもしれませんが,「有効ブック」で保存できていなくても問題ないという理解でよろしいでしょうか。
(2)以下のコードはiが変わるごとに保存画面が出てきて,毎回「保存」をクリックして,一つずつ保存されます。考えている内容からして,最大で7くらいなので,毎回「保存」をクリックしてもいいのですが,1回で指定したiの最大値までの番号を含むファイル名が生成保存されることは不可能でしょうか。保存先は同一のフォルダー内です。
よろしくお願いいたします。
Sub test1()
Dim FilePath As String Dim i As Long
For i = 1 To 3 FilePath = Application.GetSaveAsFilename(InitialFileName:="xxxxx" & i & ".xlsm", FileFilter:="Excelマクロ有効ブック, *.xlsm") ThisWorkbook.SaveAs Filename:=FilePath Next i
End Sub
< 使用 Excel:Microsoft365、使用 OS:Windows11 >
ご説明ありがとうございます。(1)は書き込ませていただいたように,通常保存(VBAで保存コードを作成しないもの)でもそうなっております。ここは問題ないということで理解いたしました。
(2)につきましては,親Bookがあり,そのファイル名がxxxxx.xlsm だとします。このファイル名に番号をつけて(すなわち,xxxx1.xlsm, xxxx2.xlsm, .....)子Bookをiの数だけ,同じフォルダーに作成保存したいのです。その際,フォルダーはユーザーが指定できるようにしたいわけです。
VBAでどうしても(2)ができなければ諦めますが(i < 7 なので手作業でやっても差し支えありませんが),可能性があるなら知りたいと思い,勉強のために質問させていただきました。
よろしくお願いいたします。
(暑い) 2023/07/26(水) 12:17:45
はい,ご質問の通りです。そんなこと,可能なのでしょうか?
(暑い) 2023/07/26(水) 14:55:07
■1
>以下のコードはiが変わるごとに保存画面が出てきて
そりゃ、そういうコードになっているからです。
>子Bookをiの数だけ,【同じフォルダー】に作成保存したいのです。
それなら、ループの中に指定する部分があるのは変だとおもいませんか?
■2
たぶん、やろうとしていることは複製を作ろうとしているので【SaveAs】じゃなくて【SaveCopyAs】の領分だとおもいます。
すなわち↓のようなことじゃないのでしょうか?
※完成品のプレゼントを意図したものではありませんので丸パクリして完成!というのはご遠慮ください。 ※【ステップ実行】等により研究の上、必要な部分のみご自身のコードに組み込んでください。
Sub 研究用() Dim フォルダPath As String Dim i As Long Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject")
'▼フォルダを指定してもらう部分 With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then フォルダPath = .SelectedItems(1) Else MsgBox "フォルダが指定されなかったので処理を中止します" Exit Sub End If End With
'▼指定されたフォルダに複製保存する部分 With ActiveWorkbook For i = 1 To 3 .SaveCopyAs フォルダPath & "\" & FSO.GetBaseName(.FullName) & Format(i, "(0).") & FSO.GetExtensionName(.FullName) Next i End With End Sub
(もこな2 ) 2023/07/26(水) 14:59:31
お礼のお返事が遅くなり申し訳ございませんでした。SaveCopyAsですね。いただいたコードを参考にしながらも,丸写しにならないように,私の仕様に合わせて活用させていただきたいと思います。ありがとうございました。
(暑い) 2023/07/27(木) 11:06:17
■3
【SaveAs】メソッドで出来ないという話ではないです。
ただ、SaveAsメソッドで処理したら対象ブックの名前が逐一変わっちゃいます。(今回のケースはそれでも困らないのでしょうが。)
Sub 研究用2() Stop 'ブレークポイントの代わり
Dim ファイルパス As String, フォルダパス As String, ファイル名 As String, ベース名 As String, 拡張子 As String Dim i As Long, 保存形式 As Long, buf As Variant
ファイルパス = Application.GetSaveAsFilename(InitialFileName:="子.xlsm", FileFilter:="Excelマクロ有効ブック, *.xlsm")
buf = Split(ファイルパス, "\") buf(UBound(buf)) = ""
フォルダパス = Join(buf, "\") ベース名 = CreateObject("Scripting.FileSystemObject").GetBaseName(ファイルパス) 拡張子 = CreateObject("Scripting.FileSystemObject").GetExtensionName(ファイルパス)
Select Case LCase(拡張子) Case "xls": 保存形式 = xlWorkbookNormal Case "xlsx": 保存形式 = xlWorkbookDefault Case "xlsm": 保存形式 = xlOpenXMLWorkbookMacroEnabled Case Else MsgBox "想定外の拡張子のため処理を中止します" Exit Sub End Select
With ActiveWorkbook For i = 1 To 3 .SaveAs _ Filename:=フォルダパス & ベース名 & Format(i, "(0)"), _ FileFormat:=保存形式 Next i End With End Sub
■4
>SaveCopyAsですね。
上記のように、SaveAsメソッドでも処理可能なのですが、ループの中で逐一ダイアログを出していたのが問題だったとおもいます。
※Application.GetSaveAsFilename(〜〜)は、ファイルパスを取得しているだけで、実際に保存しているわけでない。
(もこな2 ) 2023/07/27(木) 12:11:25
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.