' ============================================================================== ' 类模块: clsErrorLogger ' 职责: 错误日志记录器 (修正版:移除UDT,使用数组存储) ' ============================================================================== Option Explicit Private pErrors As Collection Private pWarnings As Collection Private Sub Class_Initialize() Set pErrors = New Collection Set pWarnings = New Collection End Sub ' 记录错误 Public Sub Record(OrderNo As String, SourceFunc As String, ErrorType As String, Desc As String, Context As String) ' 使用数组存储单条错误信息:生产订单号, 来源, 类型, 描述, 上下文 pErrors.Add Array(OrderNo, SourceFunc, ErrorType, Desc, Context) End Sub ' 是否有错误 Public Property Get HasErrors() As Boolean HasErrors = (pErrors.count > 0) End Property ' 是否有警告 Public Property Get HasWarnings() As Boolean HasWarnings = (pWarnings.count > 0) End Property ' 是否有问题(错误或警告) Public Property Get HasIssues() As Boolean HasIssues = (pErrors.count > 0 Or pWarnings.count > 0) End Property ' 记录警告 Public Sub RecordWarning(OrderNo As String, SourceFunc As String, WarningType As String, Desc As String, Context As String) pWarnings.Add Array(OrderNo, SourceFunc, WarningType, Desc, Context) End Sub ' 输出报告到新工作表 Public Sub PrintReport(targetWb As Workbook) If pErrors.count = 0 And pWarnings.count = 0 Then Exit Sub Dim ws As Worksheet Set ws = targetWb.Worksheets.Add(After:=targetWb.Worksheets(targetWb.Worksheets.count)) ws.Name = "错误报告_" & Format(Now, "hhmmss") ' 表头 (增加"类型"列) ws.Range("A1:F1").Value = Array("类型", "生产订单号", "来源模块", "错误类型", "详细描述", "原始数据") ws.Range("A1:F1").Font.Bold = True ws.Range("A1:F1").Interior.Color = RGB(217, 217, 217) ' 准备输出数组 Dim totalIssues As Long totalIssues = pErrors.count + pWarnings.count Dim arrOutput() As Variant ReDim arrOutput(1 To totalIssues, 1 To 6) Dim i As Long Dim vItem As Variant ' 先输出错误 For i = 1 To pErrors.count vItem = pErrors(i) arrOutput(i, 1) = "错误" arrOutput(i, 2) = vItem(0) arrOutput(i, 3) = vItem(1) arrOutput(i, 4) = vItem(2) arrOutput(i, 5) = vItem(3) arrOutput(i, 6) = vItem(4) Next i ' 再输出警告 For i = 1 To pWarnings.count vItem = pWarnings(i) arrOutput(pErrors.count + i, 1) = "警告" arrOutput(pErrors.count + i, 2) = vItem(0) arrOutput(pErrors.count + i, 3) = vItem(1) arrOutput(pErrors.count + i, 4) = vItem(2) arrOutput(pErrors.count + i, 5) = vItem(3) arrOutput(pErrors.count + i, 6) = vItem(4) Next i ws.Range("A2").Resize(totalIssues, 6).Value = arrOutput ' 标记错误和警告行 If totalIssues > 0 Then Dim rngErrors As Range Dim rngWarnings As Range If pErrors.count > 0 Then Set rngErrors = ws.Range("A2").Resize(pErrors.count, 6) rngErrors.Interior.Color = RGB(255, 200, 200) End If If pWarnings.count > 0 Then Set rngWarnings = ws.Range("A" & (pErrors.count + 2)).Resize(pWarnings.count, 6) rngWarnings.Interior.Color = RGB(255, 255, 200) End If End If ws.Columns.AutoFit End Sub