久しぶりのエクセル備忘録の話でも。
マクロのファイルを普通のエクセル形式にして出力する案件があった。いちいち、ファイル名を書き換えたりするのは面倒だったので、ChatGPTにつくってもらった。
要件としては、
① このファイルをエクセルに出力する。出力先は\\＊＊＊.＊＊￥である。
② ファイル名は、シート名「PT」のセル「G3」を参照にして、たとえばG3のセルが2024/04/16であれば、これをテキストにして20240416と頭につけて、20240416＊＊＊＊.xlsxとする。マクロの機能は無効にしてもらっても構わないです。
③ 同一のファイル名があれば、即座に上書きしてもらって構わない。
という条件でつくってもらった。
さらに、これを開くとシートが３つあり、希望するシート「PT」（ピボットテーブルの意味）が表面に開くよう、シートを一番左に移動してもらった。
できたのが、こちら。昔はマクロは非常に難しいところとされていたが、いまでは、とても簡単なのである。
Sub エクセルを出力する()
Dim wb As Workbook
Dim ws As Worksheet
Dim fileName As String
Dim outputPath As String
' 出力先パス
outputPath = "\\＊＊＊＊＊＊\＊＊＊＊＊＊\"
' ファイル名の作成
fileName = Format(Sheets("PT").Range("G3").Value, "YYYYMMDD") & "＊＊＊＊.xlsx"
' 新しいブックを作成
Set wb = Workbooks.Add
' すべてのシートをコピーして貼り付け
For Each ws In ThisWorkbook.Sheets
ws.Copy After:=wb.Sheets(wb.Sheets.Count)
Next ws
' シート1の削除
Application.DisplayAlerts = False
wb.Sheets(1).Delete
Application.DisplayAlerts = True
' PTシートを一番左に移動
wb.Sheets("PT").Move Before:=wb.Sheets(1)
' ファイルが存在する場合は即座に上書き
On Error Resume Next
Kill outputPath & fileName
On Error GoTo 0
' ファイルを保存
wb.SaveAs outputPath & fileName
' ブックを閉じる
wb.Close SaveChanges:=True
' 終了メッセージの表示
MsgBox "ファイルが出力されました。"
End Sub