admin/AutoBOM
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: add Access data integration and total queue number column

Browse Source 
- Add new AccessDataModule for fetching data from Access database based on total queue number
- Add CommandButton3_Click handler in Sheet9 for Access data fetch
- Add support for new "总排号" (Total Queue Number) column at column A
- Adjust all column indices to accommodate the new column (shifted by +1)
- Standardize code style: Collection, Count, Quantity, ProductModel, Description
- Fix inventory check result to write to correct column (F instead of E)

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
Misaka_Company
2026-03-12 13:53:28 +08:00
parent 787b3f56ab
commit 1747af046b
9 changed files with 343 additions and 145 deletions
Download Patch File Download Diff File Expand all files Collapse all files

81
VBA/Modules/BIPUploadModule.bas
View File

@@ -64,7 +64,7 @@ Public Sub ProcessOrdersToBIP()
' 获取订单数据行数
Dim lastRow As Long
lastRow = orderSheet.Cells(orderSheet.Rows.Count, 1).End(xlUp).row
lastRow = orderSheet.Cells(orderSheet.Rows.count, 1).End(xlUp).row
' 如果只有表头或没有数据
If lastRow < 2 Then
@@ -73,8 +73,8 @@ Public Sub ProcessOrdersToBIP()
End If
' 处理每个订单，收集所有输出数据
Dim outputData As collection
Set outputData = New collection
Dim outputData As Collection
Set outputData = New Collection
Dim i As Long
Dim processedCount As Long
@@ -85,20 +85,23 @@ Public Sub ProcessOrdersToBIP()
For i = 2 To lastRow
' 读取订单数据
Dim totalQueueNum As String
Dim orderNumber As String
Dim productModel As String
Dim quantity As String
Dim ProductModel As String
Dim Quantity As String
Dim productCode As String
Dim componentPriority As String
orderNumber = Trim(orderSheet.Cells(i, 1).value) ' A列：生产订单号
productModel = Trim(orderSheet.Cells(i, 2).value) ' B列：产品型号
quantity = Trim(orderSheet.Cells(i, 3).value) ' C列：数量
productCode = Trim(orderSheet.Cells(i, 4).value) ' D列：产品编码
componentPriority = Trim(orderSheet.Cells(i, 5).value) ' E列：部件优先
' --- 核心修改：调整列索引以适应新增的A列“总排号” ---
totalQueueNum = Trim(orderSheet.Cells(i, 1).value) ' A列：总排号 (如果后续BIP需要可直接使用此变量)
orderNumber = Trim(orderSheet.Cells(i, 2).value) ' B列：生产订单号
ProductModel = Trim(orderSheet.Cells(i, 3).value) ' C列：产品型号
Quantity = Trim(orderSheet.Cells(i, 4).value) ' D列：数量
productCode = Trim(orderSheet.Cells(i, 5).value) ' E列：产品编码
componentPriority = Trim(orderSheet.Cells(i, 6).value) ' F列：部件优先
' 跳过空行
If orderNumber = "" And productModel = "" Then
If orderNumber = "" And ProductModel = "" Then
GoTo ContinueLoop
End If
@@ -108,12 +111,12 @@ Public Sub ProcessOrdersToBIP()
GoTo ContinueLoop
End If
If productModel = "" Then
If ProductModel = "" Then
MsgBox "第" & i & "行：产品型号为空，跳过该行!", vbExclamation
GoTo ContinueLoop
End If
If quantity = "" Then
If Quantity = "" Then
MsgBox "第" & i & "行：数量为空，跳过该行!", vbExclamation
GoTo ContinueLoop
End If
@@ -121,7 +124,7 @@ Public Sub ProcessOrdersToBIP()
orderCount = orderCount + 1
' 处理单个订单，收集输出数据
ProcessSingleOrder orderNumber, productModel, quantity, productCode, _
ProcessSingleOrder orderNumber, ProductModel, Quantity, productCode, _
componentPriority, BomExtractor, outputData
processedCount = processedCount + 1
@@ -129,7 +132,7 @@ ContinueLoop:
Next i
' 批量写入数据到工作表
If outputData.Count > 0 Then
If outputData.count > 0 Then
WriteBatchData bipSheet, outputData
End If
@@ -141,7 +144,7 @@ ContinueLoop:
MsgBox "处理完成!" & vbCrLf & _
"处理订单数: " & orderCount & vbCrLf & _
"生成BIP行数: " & outputData.Count & vbCrLf & _
"生成BIP行数: " & outputData.count & vbCrLf & _
"用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation
' 激活BIP上传模板
@@ -150,7 +153,7 @@ ContinueLoop:
Exit Sub
ErrorHandler:
MsgBox "处理异常: " & Err.description, vbCritical
MsgBox "处理异常: " & Err.Description, vbCritical
End Sub
'=====================================================================
@@ -165,18 +168,18 @@ End Sub
' outputData - 输出数据集合
'=====================================================================
Private Sub ProcessSingleOrder(orderNumber As String, _
productModel As String, _
quantity As String, _
productCode As String, _
componentPriority As String, _
BomExtractor As BomExtractor, _
outputData As collection)
ProductModel As String, _
Quantity As String, _
productCode As String, _
componentPriority As String, _
BomExtractor As BomExtractor, _
outputData As Collection)
On Error Resume Next
' 根据部件优先设置排除类别
BomExtractor.ClearExcludeCategories
If UCase(componentPriority) = "否" Or componentPriority = "0" Or componentPriority = "FALSE" Then
Dim excludeCats As New collection
Dim excludeCats As New Collection
excludeCats.Add "部件"
BomExtractor.SetExcludeCategories excludeCats
End If
@@ -188,15 +191,15 @@ Private Sub ProcessSingleOrder(orderNumber As String, _
Dim extractNote As String
extractNote = ""
If Not parser.Parse(productModel) Then
If Not parser.Parse(ProductModel) Then
' 解析失败，添加一行错误记录
extractNote = "解析失败: " & parser.ErrorMessage
outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, 1, "", extractNote)
outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "", extractNote)
Exit Sub
End If
' 提取BOM
Dim matchedItems As collection
Dim matchedItems As Collection
Set matchedItems = BomExtractor.ExtractBom(parser.Conditions)
' 获取错误信息
@@ -207,12 +210,12 @@ Private Sub ProcessSingleOrder(orderNumber As String, _
End If
' 输出结果
If matchedItems.Count = 0 Then
If matchedItems.count = 0 Then
' 没有匹配项，添加一行空记录
If extractNote = "" Then
extractNote = "未匹配到任何物料"
End If
outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, 1, "", extractNote)
outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "", extractNote)
Else
' 输出每个匹配的物料
Dim item As BomItem
@@ -230,7 +233,7 @@ Private Sub ProcessSingleOrder(orderNumber As String, _
End If
' 创建BIP行数据并添加到集合
outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, _
outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, _
lineIndex, item.Code66, itemNote)
lineIndex = lineIndex + 1
@@ -251,7 +254,7 @@ End Sub
'=====================================================================
Private Function CreateBIPRowArray(orderNumber As String, _
productCode As String, _
quantity As String, _
Quantity As String, _
lineIndex As Long, _
materialCode As String, _
note As String) As Variant()
@@ -259,13 +262,13 @@ Private Function CreateBIPRowArray(orderNumber As String, _
rowData(1) = orderNumber ' 来源单据号（生产订单号）
rowData(2) = productCode ' 产品编码
rowData(3) = quantity ' 生产数量
rowData(3) = Quantity ' 生产数量
rowData(4) = ROW_NUMBER_BASE + lineIndex ' 行号 = 基数 + 索引
rowData(5) = materialCode ' 材料编码（66编码）
rowData(6) = "一般发料" ' 供应方式（固定值）
rowData(7) = Date ' 需用日期（当天日期）
rowData(8) = "重庆布莱迪仪器仪表有限公司" ' 发料组织（固定值）
rowData(9) = quantity ' 计划出库数量（与生产数量一致）
rowData(8) = "重庆布莱迪仪器仪表有限公司" ' 发料组织（固定值）
rowData(9) = Quantity ' 计划出库数量（与生产数量一致）
rowData(10) = note ' 备注
CreateBIPRowArray = rowData
@@ -277,15 +280,15 @@ End Function
' 参数: ws - 工作表对象
' outputData - 输出数据集合，每个元素是一个一维数组
'=====================================================================
Private Sub WriteBatchData(ws As Worksheet, outputData As collection)
Private Sub WriteBatchData(ws As Worksheet, outputData As Collection)
' 如果没有数据，直接返回
If outputData.Count = 0 Then
If outputData.count = 0 Then
Exit Sub
End If
' 创建二维数组
Dim rowCount As Long
rowCount = outputData.Count
rowCount = outputData.count
Dim resultData() As Variant
ReDim resultData(1 To rowCount, 1 To 10)
@@ -358,7 +361,7 @@ Private Function GetBIPUploadSheet() As Worksheet
If GetBIPUploadSheet Is Nothing Then
' 创建新工作表
Set GetBIPUploadSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
Set GetBIPUploadSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.count))
GetBIPUploadSheet.Name = wsName
End If
End Function
@@ -382,7 +385,7 @@ End Function
Private Sub ClearBIPSheetData(ws As Worksheet)
' 清空从第2行开始的所有数据
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).row
If lastRow > 1 Then
ws.Rows("2:" & lastRow).ClearContents