From 0579a546d3c724081fb3af210770da5663c2f149 Mon Sep 17 00:00:00 2001 From: Misaka_Company Date: Tue, 24 Feb 2026 12:50:35 +0800 Subject: [PATCH] =?UTF-8?q?feat:=20auto-save=20output=20workbook=20as=20BO?= =?UTF-8?q?M=E5=BA=93.xlsx=20and=20clean=20default=20sheets?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Delete default sheets (Sheet1, Sheet2, etc.) created by Workbooks.Add - Save output workbook as BOM库.xlsx in the same directory as source file - Auto-close workbook after saving - Update completion message to show save path - Use ThisWorkbook.Path to get source file directory Co-Authored-By: Claude Sonnet 4.5 --- VBA_BOMConverter/Modules/M02_DataIO.bas | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/VBA_BOMConverter/Modules/M02_DataIO.bas b/VBA_BOMConverter/Modules/M02_DataIO.bas index fcb1d8b..2e82b44 100644 --- a/VBA_BOMConverter/Modules/M02_DataIO.bas +++ b/VBA_BOMConverter/Modules/M02_DataIO.bas @@ -53,6 +53,8 @@ Public Sub WriteCategoryToNewBook(catData As Object) Dim i As Long, r As Long, c As Long Dim rowDict As Object Dim key As Variant + Dim savePath As String + Dim sheetToDelete As Worksheet If catData.count = 0 Then Exit Sub @@ -142,7 +144,27 @@ Public Sub WriteCategoryToNewBook(catData As Object) End If Next catName - MsgBox "处理完成！", vbInformation + ' 5. 删除默认工作表（Workbooks.Add 创建的空白工作表） + Application.DisplayAlerts = False ' 禁用删除确认对话框 + For Each sheetToDelete In newWb.Worksheets + If sheetToDelete.Name Like "Sheet*" Then + sheetToDelete.Delete + End If + Next sheetToDelete + Application.DisplayAlerts = True + + ' 6. 保存工作簿为 BOM库.xlsx + savePath = Thisworkbook.Path & Application.PathSeparator & "BOM库.xlsx" + + ' 如果文件已存在，先删除 + If Dir(savePath) <> "" Then + Kill savePath + End If + + newWb.SaveAs savePath, FileFormat:=xlOpenXMLWorkbook + newWb.Close SaveChanges:=False + + MsgBox "处理完成！已保存至：" & vbCrLf & savePath, vbInformation End Sub Private Function SortHeaders(keys As Variant) As String()