[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ファイル保存時に同じ名前のファイルがあったとき番号を付ける』（SPQ）
お世話になっております。
やりたいことはタイトルの通りですが、ファイル保存時に同じ名前のファイルがあったときAAA(2).xlsxのように番号を付けたいです。
保存先フォルダは
C:\Users\AAA\Desktop\BBB
保存形式はxlsx
保存するときの名前はsheet1のB2セルに入力されている数値を使用したいです。
よろしくお願いします。
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
Dir関数を使い、同じファイル名が存在しなくなるまで ループでカウントアップしてファイル名を付けてはいかが でしょう？ （MK） 2022/09/27(火) 17:09
Dir関数を使わずにFileSystemObject を使ってファイルの有無を判定する方法もあります （MK） 2022/09/27(火) 17:12
>Dir関数を使い、同じファイル名が存在しなくなるまでループでカウントアップ なるほど
Sub sample()
Const SavePath = "C:\Users\AAA\Desktop\BBB"
Dim Filename As String
Dim idx As Integer
Filename = SavePath & Worksheets("Sheet1").Range("B2").Value & ".xlsx"
Do While Dir(Filename) <> ""
i = i + 1
Filename = SavePath & Worksheets("Sheet1").Range("B2").Value & Format(i, "(0)") & ".xlsx"
Loop
ThisWorkbook.SaveCopyAs Filename:=Filename
End Sub
（´・ω・`） 2022/09/27(火) 17:25
横からおせっかい失礼します。
Const SavePath = "C:\Users\AAA\Desktop\BBB" ↓ Const SavePath = "C:\Users\AAA\Desktop\BBB\"
Dim idx As Integer ↓ Dim i As Integer
（MK） 2022/09/27(火) 17:31
ですよね.... 失礼しました （´・ω・`） 2022/09/27(火) 17:40
FileSystemObject使ったら...
Function NumberedFilename(Filename As String) As String
Dim i As Long, p As String, b As String, e As String, fn As String
With CreateObject("Scripting.FilesystemObject")
p = .GetParentFolderName(Filename)
b = .GetBaseName(Filename)
e = .GetExtensionName(Filename)
fn = .GetFileName(Filename)
i = 1
Do
NumberedFilename = .BuildPath(p, fn)
If Not .FileExists(NumberedFilename) Then Exit Do
i = i + 1
fn = b & Format$(i, "(0).") & e
Loop
End With
End Function
（白茶） 2022/09/27(火) 17:58
Option Explicit
Sub 複数のシートを別ブックとして保存()
Dim new_file As String
new_file = Sheet1.Range("B2").Text
ThisWorkbook.Worksheets(Array("Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet8", "Sheet11")).Copy
Application.DisplayAlerts = False '確認メッセージの非表示
ActiveWorkbook.SaveAs Filename:="C:\Users\AAA\Desktop\CCC\" & new_file, CreateBackup:=False, FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close
End Sub
複数のシートを別のブックに保存するマクロを色々検索してして作りました
これを（´・ω・`）さんの最初のマクロに組み込む場合どのような記述になるのでしょうか
（SPQ） 2022/09/28(水) 11:36
＞これを（´・ω・`）さんの最初のマクロに組み込む場合どのような記述になるのでしょうか
そもそも、皆さんがアドバイスされた方法の仕組みを理解されているのでしょうか？
要は、ファイル名（フルパス）を組み立てたときに、そのファイルが無いという状況まで繰り返し処理で枝番号を加算しているだけですよね。
なので、たとえば↓のようにすればよいでしょう。
Sub 整理()
Dim ベース As String
Dim 枝番号 As String
Dim c As Long
ベース = "C:\Users\AAA\Desktop\BBB\" & Sheet1.Range("B2").Text
Stop 'ブレークポイントの代わり
Do Until Dir(ベース & 枝番号 & ".xlsm") = ""
c = c + 1
枝番号 = "(" & c & ")"
Stop 'ブレークポイントの代わり
Loop
Stop 'ブレークポイントの代わり
Debug.Print ベース & 枝番号
ThisWorkbook.Worksheets(Array("Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet8", "Sheet11")).Copy
With Workbooks(Workbooks.Count)
.SaveAs Filename:=ベース & 枝番号, FileFormat:=xlOpenXMLWorkbookMacroEnabled
.Close
End With
End Sub
（もこな２） 2022/09/28(水) 12:40
ありがとうございます
マクロを実行すると任意のシートが別ブックにまとまり、同じ名前があった場合、連番が付くようになりました。
作成されたブックを開くと以下のようなメッセージが出ます。
このブックには、安全ではない可能性のある外部ソースへのリンクが1つ以上含まれています。
リンクを信頼できる場合、リンクを更新して最新データを取り込みます。信頼できない場合は、データをそのまま手元で処理してかまいません。
元のブックにあったマクロも無くなってしまいました。
https://vbabeginner.net/how-to-create-a-personal-macro-book/
にあるように個人用マクロブックというものを作るしかないのでしょうか
（SPQ） 2022/09/28(水) 16:07
マクロ有りブックをマクロ無しブック形式で 保存したのではないですか？
元ブックがxlsmだったらマクロ有りブックです。 xlsxはマクロ無しブックです。
また、マクロ有りブックで保存するときは、 ファイル形式も指定してやる必要があります。 （MK） 2022/09/28(水) 16:20
参考HPです。
https://www.sejuku.net/blog/67491
（MK） 2022/09/28(水) 16:27
もこな2さんのコードのきちんと書かれてましたね。 失礼いたしました。 （MK） 2022/09/28(水) 16:29
シートモジュール以外の箇所にマクロを記述してある 場合は、ブックごとコピーしない限りマクロは引き継 がれません。
ブックを丸ごと複製して不要なシートを削除するか、 お察しのとおり個人用マクロブックを使用する、あるいは アドイン化する、他のブックを制御するマクロ用ブックを 作成する、などの方法があります。 （MK） 2022/09/28(水) 16:45
いつもALT＋F11を押して、Microsoft Excel Objectsを右クリックして、挿入(N)、標準モジュール(M)でマクロを作っていました。
更新がかぶってしまったようです。すみません。
もこな２さん
MKさん
そうなんですか。知りませんでした。私の無知でもこな２さんに余計な手間をかけさせてしまいました。
ありがとうございました。
（SPQ） 2022/09/28(水) 16:53
＞元のブックにあったマクロも無くなってしまいました。
既に指摘があるように、コピーしているのは【シート】ですから、（対象の）シートモジュール以外に記述されているものはコピーされません。
そもそも論なのですが、マクロ付きブックである必要があるのですか？
「2022/09/28(水) 11:36」のコードで【FileFormat:=xlOpenXMLWorkbookMacroEnabled】となっていたのでそのままにしましたが、よくある勘違いとしてマクロ付きブックからコピーするので、必ずマクロ付きブックでコピーしなければならないと思い込んでいるケースがあります。
そうではなくて、どうしても、標準モジュールやWorkbookモジュールを保持したままで、コピーしたいというのであれば、発想を変えて
1. 自ブックを【ファイル操作】でコピーする 2. ↑の【ファイル名を変更する】 3. ↑を自ブックとは【別のブック】として開く 4. ↑の対象シート【以外を削除する】 5. ↑を上書き保存して閉じる
というアプローチにしてみては如何でしょうか？
（もこな２） 2022/09/28(水) 17:45
1.ブックを複製する【SaveCopyAsメソッド】 2.要らないシートを削除する【ループ処理】 3.上書きして閉じる【Saveメソッドなど】
研究用に提示しておきます。
完成品のプレゼントではありませんので、【ステップ実行】して研究のうえ 必要な部分のみご自身のコードに組み込んでください。
Sub 研究用さんぷる()
Dim ベース As String, 枝番号 As String
Dim c As Long
Dim SH As Worksheet
Stop 'ブレークポイントの代わり
With ThisWorkbook
'▼ファイル名決定の処理
ベース = "C:\Users\AAA\Desktop\BBB\" & .Worksheets("Sheet1").Range("B2").Text
Do Until Dir(ベース & 枝番号 & ".xlsm") = ""
c = c + 1
枝番号 = "(" & c & ")"
Loop
'▼丸ごと別ブックとして複製
.SaveCopyAs ベース & 枝番号 & ".xlsm"
End With
'▼複製したブックを開いて、要らないシートを消した後上書き保存して閉じる
With Workbooks.Open(ベース & 枝番号 & ".xlsm")
Application.DisplayAlerts = False
For Each SH In .Worksheets
Select Case SH.Name
Case "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet8", "Sheet11"
'何もしない
Case Else
SH.Delete
End Select
Next SH
Application.DisplayAlerts = True
.Save '上書き保存
.Close False
End With
End Sub
（もこな２） 2022/09/28(水) 18:26
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.