diff --git a/VBA/ClassModules/cDynamicEvent.cls b/VBA/ClassModules/cDynamicEvent.cls new file mode 100644 index 0000000..94710e5 --- /dev/null +++ b/VBA/ClassModules/cDynamicEvent.cls @@ -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 \ No newline at end of file diff --git a/VBA/Forms/frmAddSpec.frm b/VBA/Forms/frmAddSpec.frm new file mode 100644 index 0000000..cbb20cb --- /dev/null +++ b/VBA/Forms/frmAddSpec.frm @@ -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 \ No newline at end of file