[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ファイルのワークシートを削除し、さらにxlsmをxlsx形式で保存したい』（たくぼく）
『特定のシートを削除し、マクロブックをxlsxで保存したい』（たくぼく）
本件、VBAの作成依頼となります。
あるフォルダ配下にあるファイル（xlsm）の特定のワークシート（シート名A、シート名B）のみを削除して、さらにファイルをxlsxの拡張子に変更した状態で保存させたいです。
ファイルは数十程度あり、それぞれ違うネームで同一フォルダに入っております。
マクロ実行用のファイルにモジュールを作成し、そのファイルからボタン操作して処理を実行させたいイメージです。
具体的には下記のような流れです。
1. [特定のフォルダ配下]を巡回して[対象ファイル（xlsm）]を開く
→（マクロ操作ブックの別シートに、対象ファイルの名前(A列)、ファイルパス(B列)を羅列し、そこを見て処理をさせたい
2. ↑のブックのうち[特定のワークシート（シート名A、シート名B）]を削除する →ファイルの中にある「単体テスト」「日別集計」という名前の2つのシートのみを削除させたいです。 3. 【xlsx形式】で保存する 4. ↑を閉じる 5. 2～4を繰り返し
＜ 使用 Excel：Microsoft365、使用 OS：Windows11 ＞
めちゃくちゃテキトーです ファイルがなかった場合などのエラー処理は省略してます。 マクロ操作ブックの別シートのB列のファイルパスはフルネームであることが前提です。
Sub test()
Dim FSO As Object, i As Long, buf As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
buf = FSO.GetBaseName(Cells(i, "B"))
Workbooks.Open Cells(i, "B")
With ActiveWorkbook
Application.DisplayAlerts = False
.Worksheets(Array("単体テスト", "日別集計")).Delete
.SaveAs Filename:=buf & ".xlsx", FileFormat:=xlOpenXMLWorkbook
.Close
End With
Next
Application.ScreenUpdating = True
End Sub
（フォーキー） 2023/05/07(日) 11:05:18
なお、作成依頼ということで興味はないかもしれませんがフォーキーさんの案だと「単体テスト」「日別集計」が存在しない場合エラーになっちゃうと思います。
（もこな２） 2023/05/07(日) 11:46:07
私のコードで十分動くと思うんだけど・・・ （稲葉） 2023/05/08(月) 09:12:07
■１
＞ファイルは数十程度あり、それぞれ違うネームで同一フォルダに入っております。
↑について「（マクロ操作ブックの別シートに、対象ファイルの名前(A列)、ファイルパス(B列)を羅列し、そこを見て処理をさせたい」とのことですが、そのリスト作りはどうするのでしょうか？
対象のファイルがあちこちのフォルダに散らばっているという理由でもなければ、前トピックのようにフォルダを巡回する案の方がよいように思います。
■２
こちらのトピックでコメントしたように、↓は対象のシートがないと失敗（実行エラーが発生）します。
ActiveWorkbook.Worksheets(Array("単体テスト", "日別集計")).Delete
なので基本的には、前トピックの稲葉さん案のようにエラーをスキップするとよいと思いますが、対象のシートがある場合であっても【削除した結果（表示状態の）シートが0枚になってしまう場合】は削除に失敗します。
したがって、リストに応じて処理するというよりは、処理しながらリストを作成し処理結果を出力するという処理の方が安パイな気がします。
■３
＞マクロ実行用のファイルにモジュールを作成し、そのファイルからボタン操作して処理を実行させたいイメージです。
その辺はすきにすればよいと思いますが、Excelの仕様上【同名ブック】は同時に開くことができませんので、リスト方式で行くにせよ、フォルダ巡回でいくにせよ、少なくとも【マクロ実行用のブック】と同名ブックがあったときの処理を考えておいたほうがよいとおもいます。
■４
ということを踏まえて、暇つぶしに書いてみました。
Sub 研究用()
Dim MyFile As Object
Dim dstRNG As Range
Dim tmpSH As Worksheet
Set dstRNG = ThisWorkbook.Worksheets.Add.Range("A5")
dstRNG.Parent.Range("A1:A2").Value = WorksheetFunction.Transpose(Array("対象フォルダ", "C:\あるフォルダ\"))
dstRNG.Parent.Range("A4:C4").Value = Array("元ブック名", "単体テスト", "日別集計")
Application.DisplayAlerts = False
For Each MyFile In CreateObject("Scripting.FileSystemObject").GetFolder(dstRNG.Parent.Range("A2").Value).Files
If MyFile.Type = "Microsoft Excel マクロ有効ワークシート" Then
If ThisWorkbook.Name = MyFile.Name Then
dstRNG.Resize(, 3).Value = Array(MyFile.Name, "処理不能", "処理不能")
Else
With Workbooks.Open(MyFile.Path)
dstRNG.Value = .Name
On Error Resume Next
Set tmpSH = Nothing
Set tmpSH = .Worksheets(dstRNG.Parent.Range("B4").Value)
If tmpSH Is Nothing Then
dstRNG.Offset(, 1).Value = "該当シート無し"
Else
tmpSH.Delete
dstRNG.Offset(, 1).Value = "削除" & IIf(Err.Number, "失敗", "成功")
End If
On Error GoTo 0
On Error Resume Next
Set tmpSH = Nothing
Set tmpSH = .Worksheets(dstRNG.Parent.Range("C4").Value)
If tmpSH Is Nothing Then
dstRNG.Offset(, 2).Value = "該当シート無し"
Else
tmpSH.Delete
dstRNG.Offset(, 2).Value = "削除" & IIf(Err.Number, "失敗", "成功")
End If
On Error GoTo 0
.SaveAs Filename:=.Path & "\【処理済】" & CreateObject("Scripting.FileSystemObject").GetBaseName(MyFile.Path), _
FileFormat:=xlOpenXMLWorkbook
Set dstRNG = dstRNG.Offset(1)
.Close False
End With
End If
End If
Next
Application.DisplayAlerts = True
End Sub
作成依頼ということなので、アプローチには興味皆無かもしれませんが提示しておきます。
■５
好みの部分だとは思いますが、保存するブック名に拡張子がついていない場合、保存形式に合わせてエクセル君が補完してくれますので指定しないというのも１つの手です。
（間違った拡張子を指定してしまうリスクも軽減できます）
踏まえて上記のうち、別名で保存する部分について
.SaveAs Filename:=.Path & "\【処理済】" & CreateObject("Scripting.FileSystemObject").GetBaseName(MyFile.Path), _
FileFormat:=xlOpenXMLWorkbook
↓
.SaveAs Filename:=Left(.FullName, InStrRev(.FullName, ".") - 1), FileFormat:=xlOpenXMLWorkbook
のようにするのもありかと思います。
（もこな２） 2023/05/08(月) 19:56:22
たくさんコードを作成いただきありがとうございます。恐れ入りますが、新たに追加コードの依頼をさせてください。
トピックの依頼内容に加えて、シート削除対象のファイルに対し、「補足」シートが存在した場合はそちらも削除する（存在しない場合はスルー）といったコードもお願いしたく存じます。
（たくぼく） 2023/05/10(水) 12:10:56
結果のフィードバックもないし、要求増え続けそうなので、私は降りますね。 （稲葉） 2023/05/10(水) 12:20:09
まぁ、ただ働きしてくれる人が現れず気が変わったら【自分でトライ】してみてから、"詰まっている部分を具体的に挙げて質問"してみてください。（それまではROMります）
（もこな２） 2023/05/10(水) 13:48:46
（たくぼく） 2023/05/11(木) 11:12:46
■７
＞作成いただいた皆様のマクロについても今後のマクロ作成するにあたっての知識として参考といたします。
参考としたならわかるとおもいますが、シートの削除部分の考え方は稲葉さんとおなじです。
■８
＞最後に別トピックを立ててしまうなど不手際があったり、スレッド放置してしまう形としてしまいました点につきましては改めてお詫び申し上げます。
そうおもうのであれば、ご自身で↓の始末（このトピックへリンクを張る等）をされたらいかがですか？
[[20230502101207]] 『特定のシートを削除し、マクロブックをxlsxで保存』（たくぼく）
（もこな２） 2023/05/11(木) 12:52:35
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.