feat: auto-save output workbook as BOM库.xlsx and clean default sheets
All checks were successful
NTFY Notification / notify (push) Successful in 6s

- 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 <noreply@anthropic.com>
This commit is contained in:
Misaka_Company
2026-02-24 12:50:35 +08:00
parent 541bbfe0ad
commit 0579a546d3

View File

@@ -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()