068ff5d465
- 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>
305 lines
10 KiB
Plaintext
305 lines
10 KiB
Plaintext
' ==============================================================================
|
||
' 模块名称: 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
|
||
|
||
' 初始化预览文本框
|
||
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)
|
||
|
||
' 提取不重复的 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
|
||
|
||
' 刷新列表时顺便清空预览框
|
||
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()
|
||
' 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
|
||
Debug.Print 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
|
||
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 |