本人想求購一關(guān)于ACCESS或VB處理BOM的模塊

123cn

本人想求購一關(guān)于ACCESS或VB處理BOM的模塊或解決方案,要求有完整BOM的建立,查詢,反查詢,至少要有四到五層的.
有意者請報價和簡要說明.123cn@126.com

djt

Option Compare Database

Option Explicit

Dim lngNode As Long

Sub Bom(rsBom000 As ADODB.Recordset, trv As TreeView, strMat As String, Qty As Single, Level As String)

    Dim str As String

    Dim n As Integer

    Dim rsBomZi As New ADODB.Recordset

    Dim cnPhan As New ADODB.Connection

    cnPhan.Open "rovider=MSDataShape;Data Provider=NONE"

    str = _

        "SHAPE APPEND NEW adchar(30) AS ParreName," & _

            " NEW adsingle AS ParreQty," & _

            " NEW adChar(30) AS ChildName," & _

            " NEW adsingle AS ChildQty "

    If rsExpand.State = adStateOpen Then rsExpand.Close

    rsExpand.Open str, cnPhan, adOpenStatic, adLockBatchOptimistic '打開虛構(gòu)記錄集

     If cnn.State = adStateClosed Then Call login '打開數(shù)據(jù)庫連接

   

    str = "SHAPE {select ItemName," & Qty & " as Pqty from ItemName where ItemName like '" & strMat & "' order by ItemName} APPEND"

    For n = 1 To BomLevel - 1

        str = str & " (( SHAPE {select * from BomItem} rsBom" & Format(n, "000") & " APPEND"

    Next

    str = str & " ({select * from BomItem} rsBom" & Format(n, "000")

    For n = BomLevel To 2 Step -1

        str = str & " RELATE BiItName TO BiPItName))"

    Next

    str = str & " RELATE ItemName TO BiPItName)" '數(shù)據(jù)構(gòu)型 BOM

    If rsBom000.State = adStateOpen Then rsBom000.Close

   

    rsBom000.Open str, cnn, adOpenStatic, adLockBatchOptimistic '打開0層BOM

    Dim nodeItem As Node

   

    While Not rsBom000.EOF

        Select Case Level

        Case "Single Level"

            Call BomExpandNext(rsBom000, trv, 1, Qty)

        Case "Multi Level"

        

    Set nodeItem = trv.Nodes.Add(, , "a" & lngNode, rsBom000!ItemName)

    'nodeItem.EnsureVisible

            Call BomExpand(rsBom000, trv, "a" & lngNode, 1, Qty)

        End Select

        lngNode = lngNode + 1

        rsBom000.MoveNext

        nodeItem.EnsureVisible

    Wend

    'MsgBox rsExpand.RecordCount

    rsBom000.Close

End Sub

Sub BomExpand(rst As ADODB.Recordset, trv As TreeView, strKey As String, n As Integer, Qty As Single)

    Dim rstZi As New ADODB.Recordset

    Dim BomQty As Single

    Dim nodeItem As Node

    Set rstZi = rst("rsBom" & Format(n, "000")).Value

    If rstZi.RecordCount = 0 Then Exit Sub

        While Not rstZi.EOF

            'BomQty = rstZi!BiQr / rstZi!BiPr * (1 + rstZi!BiWr)

            lngNode = lngNode + 1

            Set nodeItem = trv.Nodes.Add(strKey, etvwChild, "a" & lngNode, rstZi!BiItName)

            'nodeItem.EnsureVisible

           ' nodeItem.Expanded = False

            'MsgBox rstZi!BiItName

            Call BomExpand(rstZi, trv, "a" & lngNode, n + 1, BomQty * Qty)

            'nodeItem.EnsureVisible

            rstZi.MoveNext

        Wend

               

End Sub

Sub BomExpandNext(rsBom000 As ADODB.Recordset, rsExpand As ADODB.Recordset, rst As ADODB.Recordset, n As Integer, Qty As Single)

    Dim rstZi As New ADODB.Recordset

    Dim BomQty As Single    Set rstZi = rst("rsBom" & Format(n, "000")).Value        While Not rstZi.EOF

            BomQty = rstZi!BiQr / rstZi!BiPr * (1 + rstZi!BiWr)

            'MsgBox rstZi!BiItName

            If Left(rstZi!BiItName, 1) <> "G" Then

                rsExpand.AddNew

                rsExpand!ParreName = rsBom000!ItemName

                rsExpand!ParreQty = rsBom000!Pqty

                'If n = 1 Then

                'Else

                rsExpand!ChildName = rstZi!BiItName                'Qty = Qty * BomQty

                rsExpand!ChildQty = Format(Qty * BomQty, "##.######")

                'End If

                'Exit Sub

            Else

                Call BomExpandNext(rsBom000, rsExpand, rstZi, n + 1, BomQty * Qty)            End If

            rstZi.MoveNext

        Wend

               

End Sub

Sub BomPeg(rsBom000 As ADODB.Recordset, rsExpand As ADODB.Recordset, strMat As String, Qty As Single, Level As String)

    Dim str As String

    Dim n

tmtony

不錯,好代碼,有啟發(fā)

yodong

自己已經(jīng)解決,有自己的算法了.

宸翰

對于我這樣的菜鳥來說希望能提供文件.謝謝