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>
This commit is contained in:
24
VBA/ClassModules/cDynamicEvent.cls
Normal file
24
VBA/ClassModules/cDynamicEvent.cls
Normal 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
|
||||
271
VBA/Forms/frmAddSpec.frm
Normal file
271
VBA/Forms/frmAddSpec.frm
Normal file
@@ -0,0 +1,271 @@
|
||||
' ==============================================================================
|
||||
' 模块名称: frmAddSpec (代码后置)
|
||||
' 模块类别: 用户窗体代码 (UserForm Code)
|
||||
' 模块职责: 处理 UI 交互、数据展示联动、组装精准目标集合并调用主控中枢
|
||||
' ==============================================================================
|
||||
Option Explicit
|
||||
|
||||
' --- 模块级变量 ---
|
||||
Private mGlobalBOMs As Collection ' 内存中的 BOM 总库
|
||||
Private mDynamicCheckboxes As Collection ' 保存动态生成的复选框和事件对象
|
||||
Private mTargetWorksheet As Worksheet ' 目标工作表
|
||||
|
||||
' ==============================================================================
|
||||
' 1. 窗体初始化 (加载数据、动态生成控件)
|
||||
' ==============================================================================
|
||||
Private Sub UserForm_Initialize()
|
||||
' 尝试绑定数据源工作表
|
||||
On Error Resume Next
|
||||
Set mTargetWorksheet = ThisWorkbook.Worksheets("平台配置清单")
|
||||
On Error GoTo 0
|
||||
|
||||
If mTargetWorksheet Is Nothing Then
|
||||
MsgBox "未找到名为 [平台配置清单] 的工作表,请检查!", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 初始化策略下拉框
|
||||
With Me.cboStrategy
|
||||
.Clear
|
||||
.AddItem "APPEND"
|
||||
.AddItem "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
|
||||
|
||||
' 清理提示信息
|
||||
Me.lblLog.Caption = ""
|
||||
|
||||
' 核心:加载数据并渲染动态复选框
|
||||
LoadDataAndRender
|
||||
End Sub
|
||||
|
||||
' ==============================================================================
|
||||
' 2. 核心加载逻辑与动态渲染
|
||||
' ==============================================================================
|
||||
Private Sub LoadDataAndRender()
|
||||
' 通过主控大脑加载所有数据
|
||||
Set mGlobalBOMs = mSpecAdditionManager.LoadData(mTargetWorksheet)
|
||||
|
||||
' 提取不重复的 ItemName
|
||||
Dim dictNames As Object
|
||||
Set dictNames = CreateObject("Scripting.Dictionary")
|
||||
|
||||
Dim rowObj As cBOMRow
|
||||
For Each rowObj In mGlobalBOMs
|
||||
If rowObj.ItemName <> "" Then
|
||||
If Not dictNames.Exists(rowObj.ItemName) Then
|
||||
dictNames.Add rowObj.ItemName, 1
|
||||
End If
|
||||
End If
|
||||
Next rowObj
|
||||
|
||||
' 清空已有的动态控件
|
||||
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
|
||||
|
||||
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
|
||||
|
||||
' ==============================================================================
|
||||
' 4. 执行核心流水线
|
||||
' ==============================================================================
|
||||
Private Sub btnExecute_Click()
|
||||
' --- 校验输入 ---
|
||||
Dim paramName As String, newValue As String, strategy As String
|
||||
paramName = Trim(Me.txtParamName.Text)
|
||||
newValue = Trim(Me.txtNewValue.Text)
|
||||
strategy = Me.cboStrategy.value
|
||||
|
||||
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 & "] 规格已通过 " & strategy & " 策略注入完成。" & vbCrLf & actionLog
|
||||
Me.lblLog.ForeColor = RGB(0, 128, 0) ' 绿色
|
||||
|
||||
' 重新加载数据刷新UI
|
||||
LoadDataAndRender
|
||||
RefreshDetailsPanel
|
||||
|
||||
MsgBox "规格锻造完成!请查看表格确认结果。", vbInformation
|
||||
End Sub
|
||||
|
||||
' 关闭按钮
|
||||
Private Sub btnClose_Click()
|
||||
Unload Me
|
||||
End Sub
|
||||
Reference in New Issue
Block a user