Compare commits

..

7 Commits

Author SHA1 Message Date
Misaka_Company
0128c210f8 Update frmAddSpec form
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-03-20 13:12:00 +08:00
Misaka_Company
2d7ef5fc88 Enhance UX by replacing manual input with dropdown for parameter names
- Replace txtParamName textbox with cboParamName dropdown combobox
- Load parameter names from column C in [参数配置] worksheet
- Implement automatic population of parameter dropdown during initialization
- Set first parameter as default selection when data is available
- Add proper validation and error handling for parameter data loading
- Improve data integrity by preventing manual input errors

This enhancement significantly improves user experience by eliminating manual typing and potential typos. Users can now select parameter names from a standardized list maintained in the configuration worksheet, ensuring consistency and reducing errors in the spec addition process.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-03-19 17:33:37 +08:00
Misaka_Company
4bfbbc5b6e Refactor data source to use dedicated parameter configuration worksheet
- Add mParamWorksheet variable for parameter configuration worksheet
- Load material names from dedicated [参数配置] worksheet instead of extracting from BOM data
- Implement validation for parameter configuration worksheet existence
- Add header row logic (row 2) with data starting from row 3
- Improve code comments for better clarity
- Remove debug output for cleaner production code
- Implement proper error handling for parameter worksheet access

This architectural improvement separates configuration data from operational data, following the single responsibility principle. The [参数配置] worksheet serves as a centralized configuration source for target material names, making the system more maintainable and allowing business users to manage target materials without touching the main BOM data.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-03-19 16:46:27 +08:00
Misaka_Company
068ff5d465 Add condition preview feature to enhance user experience
- Add txtConditionPreview textbox initialization in UserForm_Initialize
- Clear preview textbox when refreshing details panel
- Implement lstDetails_Change event handler for condition preview
- Display complete condition text when user clicks on list items
- Improve readability for long/complex condition expressions
- Add debug output for troubleshooting

This enhancement allows users to easily view the full condition text for each material entry in a dedicated preview textbox, addressing the issue of long conditions being difficult to read in the narrow list column.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-03-19 16:22:15 +08:00
Misaka_Company
0a8f3708e7 Add complete UI layer for BOM spec addition operations
- Add frmAddSpec user form with interactive UI for spec management
- Implement dynamic checkbox generation for material name selection
- Support both macro and granular selection modes for target materials
- Add strategy selection dropdown (APPEND/CLONE)
- Add cDynamicEvent class for handling dynamic control events
- Integrate with mSpecAdditionManager for pipeline execution
- Provide real-time validation and user feedback
- Enable fine-grained control over which specific BOM rows to modify

This creates a user-friendly interface layer on top of the existing strategy pattern architecture, allowing users to visually select materials and execute spec addition operations through a graphical form instead of direct code manipulation.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-03-19 15:47:47 +08:00
Misaka_Company
b73e39eeee Refactor strategy pattern to implement separation of concerns
- Update IModuleProcessor interface to accept targetBOMs collection instead of targetItemName string
- Remove filtering logic from strategy implementations (AppendOnly, CloneNew)
- Add LoadData method to mSpecAdditionManager for UI initialization
- Rename ExecuteAddition to ExecutePipeline with refined parameters
- Enhance test suite to simulate fine-grained UI selection behavior
- Enable precise row-level control by delegating filtering to UI layer

This refactoring achieves better separation of concerns where:
- Strategy layer focuses purely on execution logic
- UI layer handles selection and filtering
- Manager layer coordinates the pipeline flow

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-03-19 15:04:24 +08:00
Misaka_Company
d17d7c5864 Add strategy pattern architecture for BOM module processing
- Add IModuleProcessor interface defining the processor contract
- Implement cProcessor_AppendOnly strategy for modifying existing BOM rows
- Implement cProcessor_CloneNew strategy for creating new BOM rows
- Add mProcessorFactory module for creating processor instances
- Add mSpecAdditionManager module for coordinating spec addition operations
- Enhance test suite with business logic layer and pipeline integration tests

This implements the Strategy pattern to allow flexible BOM modification behaviors while maintaining clean separation of concerns.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-03-19 14:09:29 +08:00
8 changed files with 636 additions and 24 deletions

View File

@@ -0,0 +1,22 @@
' ==============================================================================
' 模块名称: IModuleProcessor
' 模块类别: 类模块 (用作接口 Interface)
' 模块职责: 定义统一的业务处理接口。此时的策略层已完全解耦,不关心过滤逻辑。
' ==============================================================================
Option Explicit
' 方法名: ProcessSpec
' allBOMs: 总库集合 (主要用于克隆策略追加新行)
' targetBOMs: 由UI层(或中枢)精挑细选出来的目标行集合 (手术对象)
' paramName: 参数名(如 lcfw)
' newValue: 新规格代码(如 M19)
' engine: 条件注入引擎实例
Public Sub ProcessSpec( _
ByRef allBOMs As Collection, _
ByRef targetBOMs As Collection, _
ByVal paramName As String, _
ByVal newValue As String, _
ByRef engine As cConditionEngine)
'
End Sub

View File

@@ -0,0 +1,24 @@
' ==============================================================================
' 模块名称: cDynamicEvent
' 模块类别: 类模块 (Class Module)
' 模块职责: 捕获在 Frame 中动态生成的 CheckBox 的点击事件,并触发主窗体的刷新
' ==============================================================================
Option Explicit
' 声明一个带有事件的复选框对象
Public WithEvents dynCheckBox As MSForms.CheckBox
' 指向主窗体的引用,用于调用主窗体的方法
Public parentForm As Object
' ------------------------------------------------------------------------------
' 当动态生成的复选框被点击时,触发此事件
' ------------------------------------------------------------------------------
Private Sub dynCheckBox_Click()
' "显示具体物料"
If Not parentForm Is Nothing Then
If parentForm.chkShowDetails.value = True Then
parentForm.RefreshDetailsPanel
End If
End If
End Sub

View File

@@ -0,0 +1,24 @@
' ==============================================================================
' 模块名称: cProcessor_AppendOnly
' 模块类别: 类模块
' 模块职责: 通用追加策略。
' 逻辑描述: 无脑遍历传入的 targetBOMs 集合,利用引擎进行条件追加。
' ==============================================================================
Option Explicit
Implements IModuleProcessor
Private Sub IModuleProcessor_ProcessSpec( _
ByRef allBOMs As Collection, _
ByRef targetBOMs As Collection, _
ByVal paramName As String, _
ByVal newValue As String, _
ByRef engine As cConditionEngine)
Dim rowObj As cBOMRow
' UI targetBOMs
For Each rowObj In targetBOMs
rowObj.Condition = engine.InjectOr(rowObj.Condition, paramName, newValue)
Next rowObj
End Sub

View File

@@ -0,0 +1,29 @@
' ==============================================================================
' 模块名称: cProcessor_CloneNew
' 模块类别: 类模块
' 模块职责: 通用克隆新增策略。
' 逻辑描述: 遍历传入的 targetBOMs 母版集合,每遇到一个就克隆一行追加到总库,并赋新值。
' ==============================================================================
Option Explicit
Implements IModuleProcessor
Private Sub IModuleProcessor_ProcessSpec( _
ByRef allBOMs As Collection, _
ByRef targetBOMs As Collection, _
ByVal paramName As String, _
ByVal newValue As String, _
ByRef engine As cConditionEngine)
Dim rowObj As cBOMRow
Dim newRow As cBOMRow
' 为 targetBOMs 里的每一个母版克隆出一个新对象
For Each rowObj In targetBOMs
' 调用数据访问层的克隆方法,自动加入 allBOMs 总集合
Set newRow = mBOMRepository.InsertNewBOMRow(allBOMs, rowObj)
' (lcfw=M19)
newRow.Condition = paramName & "=" & newValue
Next rowObj
End Sub

355
VBA/Forms/frmAddSpec.frm Normal file
View File

@@ -0,0 +1,355 @@
' ==============================================================================
' 模块名称: frmAddSpec (代码后置)
' 模块类别: 用户窗体代码 (UserForm Code)
' 模块职责: 处理 UI 交互、数据展示联动、组装精准目标集合并调用主控中枢
' ==============================================================================
Option Explicit
' --- 模块级变量 ---
Private mGlobalBOMs As Collection ' 内存中的 BOM 总库
Private mDynamicCheckboxes As Collection ' 保存动态生成的复选框和事件对象
Private mTargetWorksheet As Worksheet ' 目标工作表 (平台配置清单)
Private mParamWorksheet As Worksheet ' 参数配置工作表 (新增)
' ==============================================================================
' 1. 窗体初始化 (加载数据、动态生成控件)
' ==============================================================================
Private Sub UserForm_Initialize()
' 尝试绑定数据源工作表
On Error Resume Next
Set mTargetWorksheet = ThisWorkbook.Worksheets("平台配置清单")
Set mParamWorksheet = ThisWorkbook.Worksheets("参数配置") ' 绑定参数表
On Error GoTo 0
If mTargetWorksheet Is Nothing Then
MsgBox "未找到名为 [平台配置清单] 的工作表,请检查!", vbCritical
Exit Sub
End If
If mParamWorksheet Is Nothing Then
MsgBox "未找到名为 [参数配置] 的工作表,无法加载物料名称列表!", vbCritical
Exit Sub
End If
' 初始化策略下拉框 (中文化显示,底层输出英文指令)
With Me.cboStrategy
.Clear
.ColumnCount = 2
.ColumnWidths = "180;0" ' 第一列中文可见,第二列英文标识隐藏
.BoundColumn = 2 ' 指定 .Value 属性读取隐藏的第二列
.AddItem "追加规格 (在原有条件上追加)"
.List(0, 1) = "APPEND"
.AddItem "克隆新增 (复制母版并生成新行)"
.List(1, 1) = "CLONE"
.ListIndex = 0 ' 默认选中 APPEND
End With
' 初始化明细列表框 (隐藏首列 ExcelRowIndex 用于唯一映射)
With Me.lstDetails
.ColumnCount = 4
.ColumnWidths = "0;60;100;150" ' 第0列宽度为0(隐藏)1列代号2列名称3列条件
.MultiSelect = fmMultiSelectMulti
.ListStyle = fmListStyleOption
End With
' 初始化参数名称下拉框 (新增)
With Me.cboParamName
.Clear
If Not mParamWorksheet Is Nothing Then
Dim paramLastRow As Long
Dim j As Long
Dim paramStr As String
' 表头在第2行数据在C列实际数据从第3行开始
paramLastRow = mParamWorksheet.Cells(mParamWorksheet.Rows.count, "C").End(xlUp).row
If paramLastRow >= 3 Then
For j = 3 To paramLastRow
paramStr = Trim(mParamWorksheet.Cells(j, 3).value)
If paramStr <> "" Then
.AddItem paramStr
End If
Next j
' 将数据中的第一个数据作为默认数据
If .ListCount > 0 Then .ListIndex = 0
End If
End If
End With
' 初始化预览文本框
On Error Resume Next
Me.txtConditionPreview.Text = ""
On Error GoTo 0
' 清理提示信息
Me.lblLog.Caption = ""
' 核心:加载数据并渲染动态复选框
LoadDataAndRender
End Sub
' ==============================================================================
' 2. 核心加载逻辑与动态渲染
' ==============================================================================
Private Sub LoadDataAndRender()
' 通过主控大脑加载所有数据 (用于明细刷新和执行手术)
Set mGlobalBOMs = mSpecAdditionManager.LoadData(mTargetWorksheet)
' 从 [参数配置] 工作表获取目标物料名称 (新逻辑)
Dim dictNames As Object
Set dictNames = CreateObject("Scripting.Dictionary")
Dim lastRow As Long
Dim i As Long
Dim itemNameStr As String
' 表头在第2行数据在A列实际数据从第3行开始
If Not mParamWorksheet Is Nothing Then
lastRow = mParamWorksheet.Cells(mParamWorksheet.Rows.count, "A").End(xlUp).row
If lastRow >= 3 Then
For i = 3 To lastRow
itemNameStr = Trim(mParamWorksheet.Cells(i, 1).value)
If itemNameStr <> "" Then
If Not dictNames.Exists(itemNameStr) Then
dictNames.Add itemNameStr, 1 ' 顺便利用字典去重
End If
End If
Next i
End If
End If
' 清空已有的动态控件
Dim ctrl As Control
For Each ctrl In Me.fraItemNames.Controls
Me.fraItemNames.Controls.Remove ctrl.Name
Next ctrl
Set mDynamicCheckboxes = New Collection
' 在 Frame 中动态生成 CheckBox
Dim key As Variant
Dim chk As MSForms.CheckBox
Dim ev As cDynamicEvent
Dim topPos As Single, leftPos As Single
Dim itemIndex As Integer
topPos = 10
leftPos = 10
itemIndex = 1
For Each key In dictNames.Keys
Set chk = Me.fraItemNames.Controls.Add("Forms.CheckBox.1", "chkDynItem_" & itemIndex, True)
chk.Caption = CStr(key)
chk.Top = topPos
chk.Left = leftPos
chk.Width = 100
chk.Height = 15
' 简单的流式布局:超出宽度则换行
leftPos = leftPos + 110
If leftPos + 100 > Me.fraItemNames.InsideWidth Then
leftPos = 10
topPos = topPos + 20
End If
' 将动态 CheckBox 绑定到自定义事件类中,以便捕获点击
Set ev = New cDynamicEvent
Set ev.dynCheckBox = chk
Set ev.parentForm = Me
mDynamicCheckboxes.Add ev
itemIndex = itemIndex + 1
Next key
' 设置 Frame 滚动条属性
Me.fraItemNames.ScrollBars = fmScrollBarsVertical
Me.fraItemNames.ScrollHeight = topPos + 30
End Sub
' ==============================================================================
' 3. 界面联动交互逻辑
' ==============================================================================
Private Sub cboStrategy_Change()
' 策略变更联动:只有 APPEND 策略才允许使用细粒度列表
If Me.cboStrategy.value = "CLONE" Then
Me.chkShowDetails.value = False
Me.chkShowDetails.Enabled = False
Else
Me.chkShowDetails.Enabled = True
End If
RefreshDetailsPanel
End Sub
Private Sub chkShowDetails_Click()
RefreshDetailsPanel
End Sub
Private Sub chkSelectAllDetails_Click()
Dim i As Integer
For i = 0 To Me.lstDetails.ListCount - 1
Me.lstDetails.Selected(i) = Me.chkSelectAllDetails.value
Next i
End Sub
' 供 cDynamicEvent 调用的公开刷新方法
Public Sub RefreshDetailsPanel()
Me.lstDetails.Clear
Me.chkSelectAllDetails.value = False
' 刷新列表时顺便清空预览框
On Error Resume Next
Me.txtConditionPreview.Text = ""
On Error GoTo 0
If Not Me.chkShowDetails.value Then Exit Sub ' 未开启显示明细则跳过
' 收集目前被勾选的宏观名称
Dim checkedNames As Object
Set checkedNames = CreateObject("Scripting.Dictionary")
Dim ev As cDynamicEvent
For Each ev In mDynamicCheckboxes
If ev.dynCheckBox.value = True Then
checkedNames.Add ev.dynCheckBox.Caption, 1
End If
Next ev
If checkedNames.count = 0 Then Exit Sub
' 遍历总库,把符合勾选名称的物料填充到 ListBox
Dim rowObj As cBOMRow
For Each rowObj In mGlobalBOMs
If checkedNames.Exists(rowObj.ItemName) Then
Me.lstDetails.AddItem rowObj.ExcelRowIndex ' 第 0 列隐藏存物理行号作为唯一ID
Me.lstDetails.List(Me.lstDetails.ListCount - 1, 1) = rowObj.Code
Me.lstDetails.List(Me.lstDetails.ListCount - 1, 2) = rowObj.ItemName
Me.lstDetails.List(Me.lstDetails.ListCount - 1, 3) = rowObj.Condition
End If
Next rowObj
End Sub
' ==============================================================================
' 新增:处理列表框点击事件,将超长的选择条件发送到预览框自动换行显示
' ==============================================================================
Private Sub lstDetails_Change()
' 在 MultiSelect 模式下Click 事件不生效,必须使用 Change 事件
' ListIndex 代表当前具有虚线焦点框的行(即刚刚被点击的行)
If Me.lstDetails.ListIndex >= 0 Then
On Error Resume Next
' 获取隐藏列中的物理行号
Dim targetId As Long
targetId = CLng(Me.lstDetails.List(Me.lstDetails.ListIndex, 0))
' 去内存库里抓取完整的 Condition赋值给预览框
Dim rowObj As cBOMRow
For Each rowObj In mGlobalBOMs
If rowObj.ExcelRowIndex = targetId Then
Me.txtConditionPreview.Text = rowObj.Condition
Exit For
End If
Next rowObj
On Error GoTo 0
End If
End Sub
' ==============================================================================
' 4. 执行核心流水线
' ==============================================================================
Private Sub btnExecute_Click()
' --- 校验输入 ---
Dim paramName As String, newValue As String, strategy As String, strategyName As String
paramName = Trim(Me.cboParamName.Text)
newValue = Trim(Me.txtNewValue.Text)
strategy = Me.cboStrategy.value ' 获取隐藏的底层代码 (APPEND / CLONE)
strategyName = Me.cboStrategy.Text ' 获取界面显示的中文名称
If paramName = "" Or newValue = "" Then
MsgBox "参数名称和新增规格值不能为空!", vbExclamation
Exit Sub
End If
' 收集在宏观 Frame 中被勾选的名称
Dim checkedNames As Object
Set checkedNames = CreateObject("Scripting.Dictionary")
Dim ev As cDynamicEvent
For Each ev In mDynamicCheckboxes
If ev.dynCheckBox.value = True Then checkedNames.Add ev.dynCheckBox.Caption, 1
Next ev
If checkedNames.count = 0 Then
MsgBox "请至少勾选一个目标物料名称!", vbExclamation
Exit Sub
End If
' --- 组装精准的 targetBOMs 集合 ---
Dim targetBOMs As New Collection
Dim rowObj As cBOMRow
Dim i As Integer
Dim actionLog As String
If Me.chkShowDetails.value = True Then
' 【细粒度模式】:只收集 ListBox 中打钩的明细行
Dim hasDetailChecked As Boolean
hasDetailChecked = False
For i = 0 To Me.lstDetails.ListCount - 1
If Me.lstDetails.Selected(i) = True Then
hasDetailChecked = True
Dim targetId As Long
targetId = CLng(Me.lstDetails.List(i, 0)) ' 取出隐藏的物理行号
' 在总库中找到对应的对象并塞入目标集合
For Each rowObj In mGlobalBOMs
If rowObj.ExcelRowIndex = targetId Then
targetBOMs.Add rowObj
Exit For
End If
Next rowObj
End If
Next i
If Not hasDetailChecked Then
MsgBox "开启了细粒度筛选,请至少在下方列表中勾选一条物料!", vbExclamation
Exit Sub
End If
actionLog = "细粒度模式更新了 " & targetBOMs.count & " 条特定物料。"
Else
' 【宏观模式】:收集所有符合打钩名称的行
For Each rowObj In mGlobalBOMs
If checkedNames.Exists(rowObj.ItemName) Then
targetBOMs.Add rowObj
End If
Next rowObj
actionLog = "宏观模式扫描了 " & targetBOMs.count & " 条变种物料。"
End If
' --- 调用调度中枢进行外科手术 ---
Me.btnExecute.Caption = "正在处理..."
Me.btnExecute.Enabled = False
DoEvents ' 刷新UI防止假死
' 执行!
mSpecAdditionManager.ExecutePipeline mTargetWorksheet, mGlobalBOMs, targetBOMs, paramName, newValue, strategy
' --- 完成与恢复 ---
Me.btnExecute.Caption = "保存入库 (执行)"
Me.btnExecute.Enabled = True
Me.txtNewValue.Text = ""
Me.lblLog.Caption = "成功![" & newValue & "] 规格已通过 [" & strategyName & "] 处理完成。" & vbCrLf & actionLog
Me.lblLog.ForeColor = RGB(0, 128, 0) ' 绿色
' 重新加载数据刷新UI
LoadDataAndRender
RefreshDetailsPanel
MsgBox "规格新增完成!请查看表格确认结果。", vbInformation
End Sub
' 关闭按钮
Private Sub btnClose_Click()
Unload Me
End Sub

View File

@@ -0,0 +1,27 @@
' ==============================================================================
' 模块名称: mProcessorFactory
' 模块类别: 标准模块 (Standard Module)
' 模块职责: 负责根据传入的策略类型标识,实例化并返回对应的业务策略对象
' ==============================================================================
Option Explicit
' ------------------------------------------------------------------------------
' 函数名称: GetProcessor
' 函数功能: 根据策略别名,返回对应的 IModuleProcessor 实现类
' 参数说明: strategyType - 策略标识 (例如 "APPEND" 或 "CLONE")
' ------------------------------------------------------------------------------
Public Function GetProcessor(ByVal strategyType As String) As IModuleProcessor
Select Case UCase(Trim(strategyType))
Case "APPEND"
' 返回追加策略实例
Set GetProcessor = New cProcessor_AppendOnly
Case "CLONE"
' 返回克隆新增策略实例
Set GetProcessor = New cProcessor_CloneNew
Case Else
' 如果传入了未知的策略,主动抛出异常阻断运行
Err.Raise vbObjectError + 513, "ProcessorFactory", "未知的业务处理策略: " & strategyType
End Select
End Function

View File

@@ -0,0 +1,58 @@
' ==============================================================================
' 模块名称: mSpecAdditionManager
' 模块类别: 标准模块 (Standard Module)
' 模块职责: 整个架构的主控大脑,负责协调各层组件,完成端到端的数据处理流水线
' ==============================================================================
Option Explicit
' ------------------------------------------------------------------------------
' 过程名称: LoadData
' 过程功能: 供 UI 初始化时调用,加载总库数据
' ------------------------------------------------------------------------------
Public Function LoadData(ByVal ws As Worksheet) As Collection
Set LoadData = mBOMRepository.LoadAllBOMs(ws)
End Function
' ------------------------------------------------------------------------------
' 过程名称: ExecutePipeline
' 过程功能: 执行完整的新增规格流水线
' 参数说明:
' ws - 目标工作表对象 (保存时需要)
' allBOMs - 内存中的总库集合
' targetBOMs - UI层过滤组装好的【精准目标集合】
' paramName - 要修改的参数名 (如 "lcfw")
' newValue - 新增的规格值 (如 "M19")
' strategyType - UI选择的执行策略 (如 "APPEND" 或 "CLONE")
' ------------------------------------------------------------------------------
Public Sub ExecutePipeline( _
ByVal ws As Worksheet, _
ByRef allBOMs As Collection, _
ByRef targetBOMs As Collection, _
ByVal paramName As String, _
ByVal newValue As String, _
ByVal strategyType As String)
' 如果没有选中任何目标,直接中断退出
If targetBOMs Is Nothing Then Exit Sub
If targetBOMs.count = 0 Then Exit Sub
Dim engine As cConditionEngine
Dim processor As IModuleProcessor
' [步骤 1] 初始化核心手术刀引擎
Set engine = New cConditionEngine
' [步骤 2] 从工厂获取用户指定的策略
Set processor = mProcessorFactory.GetProcessor(strategyType)
' [步骤 3] 将总库、精准目标集合扔给策略对象执行
processor.ProcessSpec allBOMs, targetBOMs, paramName, newValue, engine
' [步骤 4] 将修改过的数据批量写回 Excel (只写 IsDirty=True 的对象)
mBOMRepository.SaveAll ws, allBOMs
' 释放资源
Set processor = Nothing
Set engine = Nothing
End Sub

View File

@@ -20,9 +20,15 @@ Public Sub RunBOMForgeTests()
' 执行数据模型测试
Call Test_cBOMRow
' 执行存储库数据层测试 (新增)
' 执行存储库数据层测试
Call Test_BOMRepository
' 执行业务策略层测试
Call Test_Processors
' 执行调度中枢联调测试 (新增)
Call Test_Manager_Pipeline
' ---- 输出测试汇总 ----
Debug.Print "-----------------------------------------------"
Debug.Print "测试汇总: 共 " & (passCount + failCount) & " 个用例"
@@ -77,9 +83,6 @@ Private Sub Test_ConditionEngine()
End Sub
' ==============================================================================
' 新增:针对 cBOMRow 对象的单元测试
' ==============================================================================
Private Sub Test_cBOMRow()
Debug.Print ""
Debug.Print "========== 2. 开始测试: cBOMRow 数据模型 =========="
@@ -87,38 +90,28 @@ Private Sub Test_cBOMRow()
Dim bomRow As cBOMRow
Set bomRow = New cBOMRow
' 测试初始状态:应为 Clean (False)
AssertEqual "初始脏标记测试", "False", CStr(bomRow.IsDirty)
' 模拟从 Excel 中读取数据 (此时要避开 Property Let 的脏标记触发,但既然封装了,我们就测试 Property Let)
' 实际在 Repository 载入时,载入完毕后会调用 ResetDirtyFlag
bomRow.RowNo = 700
bomRow.ModuleType = "接头"
bomRow.Code = "01081014361"
bomRow.ItemName = "径向高压接头"
bomRow.Condition = "(azxs=A0) AND gclj=Z14"
' 赋值后应该是脏的
AssertEqual "赋值后脏标记测试", "True", CStr(bomRow.IsDirty)
' 模拟保存完毕重置标记
bomRow.ResetDirtyFlag
AssertEqual "重置后脏标记测试", "False", CStr(bomRow.IsDirty)
' 模拟未改变内容的重复赋值 (脏标记不应改变)
bomRow.Condition = "(azxs=A0) AND gclj=Z14"
AssertEqual "重复赋值脏标记测试", "False", CStr(bomRow.IsDirty)
' 模拟条件引擎注入新条件 (内容变更,脏标记触发)
bomRow.Condition = "(azxs=A0) AND gclj=Z14 AND (lcfw=M19)"
AssertEqual "状态变更脏标记测试", "True", CStr(bomRow.IsDirty)
AssertEqual "属性读取测试", "(azxs=A0) AND gclj=Z14 AND (lcfw=M19)", bomRow.Condition
End Sub
' ==============================================================================
' 新增:针对 BOMRepository 存取机制的单元测试 (沙盒模式)
' ==============================================================================
Private Sub Test_BOMRepository()
Debug.Print ""
Debug.Print "========== 3. 开始测试: mBOMRepository 数据访问层 =========="
@@ -127,7 +120,6 @@ Private Sub Test_BOMRepository()
Dim wsTemp As Worksheet
Set wb = ThisWorkbook
' 1. 创建沙盒工作表
Application.DisplayAlerts = False
On Error Resume Next
wb.Worksheets("BOMForge_Test_Sandbox").Delete
@@ -135,17 +127,15 @@ Private Sub Test_BOMRepository()
Set wsTemp = wb.Worksheets.Add
wsTemp.Name = "BOMForge_Test_Sandbox"
' 2. 模拟初始化表头(第3行)和原始数据(第4,5行)
wsTemp.Cells(3, 1).value = "行号"
wsTemp.Cells(4, 1).value = 10
wsTemp.Cells(4, 2).value = "接头"
wsTemp.Cells(4, 6).value = "lcfw=M01" ' 选择条件
wsTemp.Cells(4, 6).value = "lcfw=M01"
wsTemp.Cells(5, 1).value = 20
wsTemp.Cells(5, 2).value = "盘止钉"
wsTemp.Cells(5, 6).value = "lcfw=M02"
' 3. 测试加载功能
Dim bomColl As Collection
Set bomColl = LoadAllBOMs(wsTemp)
@@ -153,36 +143,119 @@ Private Sub Test_BOMRepository()
AssertEqual "验证读取第一行", "接头", bomColl(1).ModuleType
AssertEqual "验证加载后脏标记为空", "False", CStr(bomColl(1).IsDirty)
' 4. 测试修改和保存功能 (仅修改第二行)
bomColl(2).Condition = "lcfw=M02 OR lcfw=M19"
SaveAll wsTemp, bomColl
' 验证 Excel 表格内容是否被正确写回
AssertEqual "验证Excel未被错误修改", "lcfw=M01", wsTemp.Cells(4, 6).value
AssertEqual "验证Excel正确更新", "lcfw=M02 OR lcfw=M19", wsTemp.Cells(5, 6).value
AssertEqual "验证保存后脏标记重置", "False", CStr(bomColl(2).IsDirty)
' 5. 测试新增行功能 (基于第一行克隆)
Dim newRow As cBOMRow
Set newRow = InsertNewBOMRow(bomColl, bomColl(1))
newRow.Condition = "lcfw=M19"
SaveAll wsTemp, bomColl
' 验证新增行是否保存到了第6行
AssertEqual "验证新增行集合追加", "3", CStr(bomColl.count)
AssertEqual "验证新增行Excel保存", "lcfw=M19", wsTemp.Cells(6, 6).value
AssertEqual "验证新增行Excel映射行号", "6", CStr(newRow.ExcelRowIndex)
' 6. 清理沙盒工作表
wsTemp.Delete
Application.DisplayAlerts = True
End Sub
Private Sub Test_Processors()
Debug.Print ""
Debug.Print "========== 4. 开始测试: 业务策略层 (Strategy) 细粒度新架构 =========="
Dim engine As cConditionEngine
Set engine = New cConditionEngine
Dim paramName As String: paramName = "lcfw"
Dim newValue As String: newValue = "M19"
Dim allBOMs As New Collection
Dim targetBOMs As New Collection
Dim row1 As New cBOMRow, row2 As New cBOMRow, row3 As New cBOMRow
row1.ItemName = "径向高压接头": row1.Condition = "lcfw=M12": allBOMs.Add row1
row2.ItemName = "径向高压接头": row2.Condition = "lcfw=M13": allBOMs.Add row2
row3.ItemName = "弹簧管": row3.Condition = "lcfw=M01 AND gclj!=M20": allBOMs.Add row3
' 【核心逻辑】模拟 UI 层仅将用户勾选的具体行 (比如 row1) 加入 targetBOMs 集合
targetBOMs.Add row1
' 测试 1: 追加策略 (AppendOnly)
Dim strategyAppend As IModuleProcessor
Set strategyAppend = New cProcessor_AppendOnly
strategyAppend.ProcessSpec allBOMs, targetBOMs, paramName, newValue, engine
AssertEqual "追加策略_选中的变种1被更新", "lcfw=M12 OR lcfw=M19", row1.Condition
AssertEqual "追加策略_未选中的变种2保持不变", "lcfw=M13", row2.Condition
AssertEqual "追加策略_不影响其他物料", "lcfw=M01 AND gclj!=M20", row3.Condition
' 测试 2: 克隆新增策略 (CloneNew)
Dim strategyClone As IModuleProcessor
Set strategyClone = New cProcessor_CloneNew
Dim initialCount As Integer: initialCount = allBOMs.count
' 模拟 UI 选择弹簧管作为克隆母版
Set targetBOMs = New Collection
targetBOMs.Add row3
strategyClone.ProcessSpec allBOMs, targetBOMs, paramName, newValue, engine
AssertEqual "克隆策略_总库数量增加", CStr(initialCount + 1), CStr(allBOMs.count)
AssertEqual "克隆策略_新行条件纯粹准确", "lcfw=M19", allBOMs(allBOMs.count).Condition
End Sub
' ==============================================================================
' 新增:端到端流水线集成测试
' ==============================================================================
Private Sub Test_Manager_Pipeline()
Debug.Print ""
Debug.Print "========== 5. 开始测试: 调度中枢集成测试 (Pipeline) =========="
Dim wb As Workbook
Dim wsTemp As Worksheet
Set wb = ThisWorkbook
Application.DisplayAlerts = False
On Error Resume Next
wb.Worksheets("BOMForge_Test_Pipeline").Delete
On Error GoTo 0
Set wsTemp = wb.Worksheets.Add
wsTemp.Name = "BOMForge_Test_Pipeline"
wsTemp.Cells(3, 1).value = "行号"
wsTemp.Cells(4, 1).value = 700: wsTemp.Cells(4, 4).value = "径向高压接头": wsTemp.Cells(4, 6).value = "lcfw=M12"
wsTemp.Cells(5, 1).value = 710: wsTemp.Cells(5, 4).value = "径向高压接头": wsTemp.Cells(5, 6).value = "lcfw=M13"
wsTemp.Cells(6, 1).value = 800: wsTemp.Cells(6, 4).value = "弹簧管": wsTemp.Cells(6, 6).value = "lcfw=M01"
' 模拟 UI 打开时加载数据
Dim globalBOMs As Collection
Set globalBOMs = mSpecAdditionManager.LoadData(wsTemp)
' 模拟 UI 细粒度勾选只选中了第5行 (即集合中的第2个对象)
Dim uiSelectedBOMs As New Collection
uiSelectedBOMs.Add globalBOMs(2)
' 执行调度中枢的追加流水线
mSpecAdditionManager.ExecutePipeline wsTemp, globalBOMs, uiSelectedBOMs, "lcfw", "M19", "APPEND"
AssertEqual "流水线_追加_目标行1未选中(不变)", "lcfw=M12", wsTemp.Cells(4, 6).value
AssertEqual "流水线_追加_目标行2被选中更新", "lcfw=M13 OR lcfw=M19", wsTemp.Cells(5, 6).value
AssertEqual "流水线_追加_无关行不变", "lcfw=M01", wsTemp.Cells(6, 6).value
wsTemp.Delete
Application.DisplayAlerts = True
End Sub
' ==============================================================================
' 内部辅助方法:断言测试结果
' 将期望值与实际值进行比对,并输出标准化的日志信息
' ==============================================================================
Private Sub AssertEqual(testName As String, expected As String, actual As String)
If expected = actual Then