[[20230726105657]] 『マクロ有効ブックでの保存』(暑い) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『マクロ有効ブックでの保存』(暑い)

お世話になります。

フォルダーを選択して,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)はエクスプローラー上の表記が「マクロ有効ワークシート」であることを気にしていますか?
だとすると問題ないです。というか生成したものではない普通のもそうなっていませんか?
(2)ですが、画面が出てほしくないなら Application.GetSaveAsFilenameを使うこと自体が要望に沿ってない気がしますが、それとは別の話ということですか?
(\) 2023/07/26(水) 11:53:04

\さん

ご説明ありがとうございます。(1)は書き込ませていただいたように,通常保存(VBAで保存コードを作成しないもの)でもそうなっております。ここは問題ないということで理解いたしました。

(2)につきましては,親Bookがあり,そのファイル名がxxxxx.xlsm だとします。このファイル名に番号をつけて(すなわち,xxxx1.xlsm, xxxx2.xlsm, .....)子Bookをiの数だけ,同じフォルダーに作成保存したいのです。その際,フォルダーはユーザーが指定できるようにしたいわけです。

VBAでどうしても(2)ができなければ諦めますが(i < 7 なので手作業でやっても差し支えありませんが),可能性があるなら知りたいと思い,勉強のために質問させていただきました。

よろしくお願いいたします。
(暑い) 2023/07/26(水) 12:17:45


もしかして(2)の話は1回目だけフォルダを指定させたくて
2回目以降はその指定したフォルダに自動で保存されてほしいという話ですか?
(\) 2023/07/26(水) 12:26:57

\さん

はい,ご質問の通りです。そんなこと,可能なのでしょうか?
(暑い) 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


もこな2さん

お礼のお返事が遅くなり申し訳ございませんでした。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.