单位批量引入.frm

财务信息管理系统,适合做毕业论文的人使用

Private Sub cmdSave_Click()
    Save
End Sub

Private Sub cmdHelp_Click()
    SendKeys "{F1}"
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    CenterForm Me
    Bk_Initialize
    JackSize_Initialize
    treSelInitialize
    treUnSelInitialize
    
    'Me.Icon = LoadResPicture(109, vbResIcon)
    'ImageList_Initialize ilsTree
End Sub

Private Sub Bk_Initialize()
    Dim i As Integer
    For i = 0 To 5
        bk(i).Move 210, 720
    Next i
    CurrentTab = 0
End Sub

Private Sub Tree_Initialize(tre As MSComctlLib.TreeView)
    tre.Nodes.Clear
    
    tre.Nodes.Add , , "K0", "个人"
    tre.Nodes.Add , , "K1", "部门"
    tre.Nodes.Add , , "K2", "银行"
    tre.Nodes.Add , , "K3", "客户"
    tre.Nodes.Add , , "K4", "供应商"
    tre.Nodes.Add , , "K5", "项目"
    
    tre.LineStyle = tvwRootLines
    tre.Style = tvwTreelinesPlusMinusPictureText
    tre.LabelEdit = tvwManual
    
    Dim i As Integer
    
    For i = 1 To treUnSel.Nodes.Count
        If treUnSel.Nodes(i).Children > 0 Then
            treUnSel.Nodes(i).Image = 1
        Else
            treUnSel.Nodes(i).Image = 3
        End If
    Next
End Sub

Private Sub treSelInitialize()
    Dim objAccUnitBI As New U8FDBso.clsAccUnitBI
    Dim objEO        As U8FDEso.EntityObject
    Dim objOID       As New U8FDEso.OIDObject

    Me.treSel.Nodes.Add , , "K0", "个人"
    Me.treSel.Nodes.Add , , "K1", "部门"
    Me.treSel.Nodes.Add , , "K2", "银行"
    Me.treSel.Nodes.Add , , "K3", "客户"
    Me.treSel.Nodes.Add , , "K4", "供应商"
    Me.treSel.Nodes.Add , , "K5", "项目"
    
    Me.treSel.LineStyle = tvwRootLines
    Me.treSel.Style = tvwTreelinesPlusMinusPictureText
    Me.treSel.LabelEdit = tvwManual
    
    Set objEO = objAccUnitBI.MoveTo(g_sDataSourceName, U8FDEso.esoFirst, m_conBIStyle)
    
    Dim i As Integer, RecordCount As Long
    
    RecordCount = objAccUnitBI.RecordCount(g_sDataSourceName, objEO)
    
    For i = 1 To RecordCount
        Me.treSel.Nodes.Add "K" & objEO("type_flag"), tvwChild, "K" & objEO("type_flag") & objEO("accunit_id"), objEO("accunit_code")
        objOID = objEO("accunit_id")
        Set objEO = objAccUnitBI.MoveTo(g_sDataSourceName, U8FDEso.esoNext, m_conBIStyle, objOID)
    Next
    
    For i = 1 To treSel.Nodes.Count
        If treSel.Nodes(i).Children > 0 Then
            treSel.Nodes(i).Image = 1
        Else
            treSel.Nodes(i).Image = 3
        End If
    Next

    Set objAccUnitBI = Nothing
    Set objOID = Nothing
    Set objEO = Nothing
End Sub

Private Sub treUnSelInitialize()
    Me.treUnSel.Nodes.Add , , "K0", "个人"
    Me.treUnSel.Nodes.Add , , "K1", "部门"
    Me.treUnSel.Nodes.Add , , "K2", "银行"
    Me.treUnSel.Nodes.Add , , "K3", "客户"
    Me.treUnSel.Nodes.Add , , "K4", "供应商"
    Me.treUnSel.Nodes.Add , , "K5", "项目"
    
    Me.treUnSel.LineStyle = tvwRootLines
    Me.treUnSel.Style = tvwTreelinesPlusMinusPictureText
    Me.treUnSel.LabelEdit = tvwManual
    
    Dim i As Integer
    
    For i = 1 To treUnSel.Nodes.Count
        If treUnSel.Nodes(i).Children > 0 Then
            treUnSel.Nodes(i).Image = 1
        Else
            treUnSel.Nodes(i).Image = 3
        End If
    Next
End Sub

Private Sub DataInput(iType As Integer)
    Dim SQL As String

    Select Case iType
        Case 0
            SQL = "select cPersonCode,cPersonName " & "from Person " & "order by cPersonCode"
        Case 1
            SQL = "select cDepCode,cDepName " & "from DepartMent Where Not bDepEnd=0 " & "order by cDepCode"
        Case 2
            SQL = "select cBCode,cBName " & "from Bank " & "order by cBCode"
        Case 3
            SQL = "select cCusCode,cCusAbbName " & "from Customer " & "order by cCusCode"
        Case 4
            SQL = "select cVenCode,cVenAbbName " & "from Vendor " & "order by cVenCode"
        Case 5
            SQL = "select citem_class from fitem where citem_class>='00' and  citem_class<='99' order by citem_class"
    End Select
    
    lvwSel(CurrentTab).ListItems.Clear
    ListView_Load lvwUnSel(CurrentTab), SQL
    Set_lvwUnSel_Null_False CurrentTab
End Sub

Private Sub ListView_Load(lvw As ListView, SQL As String)
    Dim con As New ADODB.Connection
    Dim rec As New ADODB.Recordset, rec2 As New ADODB.Recordset
    
    On Error Resume Next
    
    con.Open g_sDataSourceName
    
    lvw.ListItems.Clear
    If Right(SQL, 5) = "class" Then
        rec.Open SQL, con, adOpenStatic, adLockOptimistic
        With rec
            While Not .EOF
                SQL = "select '" & rec!citem_class & "' + [citemcode] as zd1,[citemname] from fitemss" & rec!citem_class & " order by [citemcode]"
                rec2.Open SQL, con, adOpenStatic, adLockOptimistic
                If Err.Number <> 0 Then GoTo nextab
                With rec2
                    While Not .EOF
                        ListView_AddItem lvw, .Fields(0).Value, .Fields(1).Value
                        .MoveNext
                    Wend
                    .Close
                End With
nextab:         .MoveNext
            Wend
            .Close
        End With
    Else
        rec.Open SQL, con, adOpenStatic, adLockOptimistic
        With rec
            While Not .EOF
                ListView_AddItem lvw, .Fields(0).Value, .Fields(1).Value
                .MoveNext
            Wend
            .Close
        End With
    End If
End Sub

Private Sub ListView_AddItem(lvw As ListView, Code As String, Name As String)
    Dim itm As ListItem
    
    'lvw.Icons = ilsTlb: lvw.SmallIcons = ilsTlb
    
    Set itm = lvw.ListItems.Add()
    'itm.SmallIcon = "a"
    itm.Text = Code
    itm.SubItems(1) = Name
End Sub

Private Sub jkrTree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button <> vbLeftButton Then Exit Sub
    drag = True
    StartX = jkrTree.Left
End Sub

Private Sub jkrTree_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If drag Then
      If x + jkrTree.Left > maxLeft Or x + jkrTree.Left < minLeft Then Exit Sub
      jkrTree.Move x + jkrTree.Left
    End If
End Sub

Private Sub jkrTree_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  If Button <> vbLeftButton Then Exit Sub
  drag = False
  EndX = jkrTree.Left
  lblExist.Width = lblExist.Width + EndX - StartX
  treSel.Width = treSel.Width + EndX - StartX
  lblInput.Left = lblInput.Left - StartX + EndX
  lblInput.Width = lblInput.Width + StartX - EndX
  treUnSel.Left = treUnSel.Left - StartX + EndX
  treUnSel.Width = treUnSel.Width + StartX - EndX
End Sub

Private Sub lvwSel_DblClick(Index As Integer)
    cmdSel_Click Index * 4 + 2
End Sub

Private Sub lvwUnSel_DblClick(Index As Integer)
    cmdSel_Click Index * 4 + 1
End Sub

Private Sub tabImport_Click()
    Dim TabIndex As Integer
    
    With tabImport
        TabIndex = .SelectedItem.Index - 1
        If CurrentTab <> TabIndex Then
            bk(CurrentTab).Visible = False
            bk(TabIndex).Visible = True
        End If
        CurrentTab = .SelectedItem.Index - 1
    End With
End Sub

Private Sub BeginImport()
    FromLvwToTre lvwSel(0), treUnSel, "K0"
    Set_lvwSel_Null_True 0
    FromLvwToTre lvwSel(1), treUnSel, "K1"
    Set_lvwSel_Null_True 1
    FromLvwToTre lvwSel(2), treUnSel, "K2"
    Set_lvwSel_Null_True 2
    FromLvwToTre lvwSel(3), treUnSel, "K3"
    Set_lvwSel_Null_True 3
    FromLvwToTre lvwSel(4), treUnSel, "K4"
    Set_lvwSel_Null_True 4
    FromLvwToTre lvwSel(5), treUnSel, "K5"
    Set_lvwSel_Null_True 5
End Sub

Private Sub Set_lvwSel_Null_True(Index As Integer)
    cmdSel(Index * 4 + 2).Enabled = False
    cmdSel(Index * 4 + 3).Enabled = False
End Sub

Private Sub Set_lvwSel_Null_False(Index As Integer)
    cmdSel(Index * 4 + 2).Enabled = True
    cmdSel(Index * 4 + 3).Enabled = True
End Sub

Private Sub Set_lvwUnSel_Null_False(Index As Integer)
    cmdSel(Index * 4).Enabled = True
    cmdSel(Index * 4 + 1).Enabled = True
End Sub

Private Sub Set_lvwUnSel_Null_True(Index As Integer)
    cmdSel(Index * 4).Enabled = False
    cmdSel(Index * 4 + 1).Enabled = False
End Sub

Private Sub FromLvwToTre(lvw As ListView, tre As MSComctlLib.TreeView, Key As String)
    Dim Node As MSComctlLib.Node
    Dim Code As String
    Dim Name As String
    Dim i    As Integer

    For i = 1 To lvw.ListItems.Count
        Code = lvw.ListItems(i).Text
        Name = lvw.ListItems(i).SubItems(1)
        On Error Resume Next
        Set Node = tre.Nodes.Add(Key, tvwChild, Key & Code, Code & Chr(9) & Name)
        Node.Image = 3
        Node.Parent.Image = 1
        If Err > 0 Then
            If Not ImportBringErrMsg(Code, Name) Then Exit Sub
            On Error GoTo 0
        End If
    Next i
    lvw.ListItems.Clear
End Sub

Private Function ImportBringErrMsg(Code As String, Name As String) As Boolean
    Dim resp
    resp = MsgBox("编码： " & Code & vbCrLf & "名称： " & Name & vbCrLf & vbCrLf & "编码冲突，放弃引入此节点！" & vbCrLf & "是否继续此次引入？", vbCritical + vbYesNo, g_conSysName)
    If resp = vbYes Then
        ImportBringErrMsg = True
    Else
        ImportBringErrMsg = False
    End If
    Err = 0
End Function

Private Sub Save()
    Dim i As Long

    On Error Resume Next
    For i = 1 To treUnSel.Nodes.Count
        If Len(treUnSel.Nodes(i).Key) > 2 Then
            SaveUnit Mid(treUnSel.Nodes(i).Key, 2, 1), Mid(treUnSel.Nodes(i).Key, 3), Mid(treUnSel.Nodes(i).Text, InStr(1, treUnSel.Nodes(i).Text, Chr(9)) + 1)
        End If
    Next i
    
    Tree_Initialize treUnSel
End Sub

Private Sub SaveUnit(Type_Flag As String, Code As String, Name As String)
    Dim objAccUnitBI As New U8FDBso.clsAccUnitBI
    Dim objEO        As U8FDEso.EntityObject
    Dim Key          As String
    
    Set objEO = objAccUnitBI.Init(g_sDataSourceName, m_conBIStyle)
    objEO.State = U8FDEso.esoAddNew
    objEO("accunit_code") = Code
    objEO("accunit_name") = Name
    objEO("type_flag") = CByte(Right(Type_Flag, 1))
    If Not objAccUnitBI.Save(g_sDataSourceName, objEO, m_conBIStyle) Then
        MsgBox "【" & Code & "," & Name & "】保存不成功!"
    Else
        Me.treSel.Nodes.Add "K" & Right(Type_Flag, 1), tvwChild, "K" & Right(Type_Flag, 1) & objEO("accunit_id"), Code
        frmAccUnit.treStyle.Nodes.Add "K" & Right(Type_Flag, 1), tvwChild, "K" & Right(Type_Flag, 1) & objEO("accunit_id"), Code
        Key = "K" & Right(Type_Flag, 1) & objEO("accunit_id")
        Me.treSel.Nodes(Key).Image = 3
        frmAccUnit.treStyle.Nodes(Key).Image = 3
    End If
    
    Set objEO = Nothing
    Set objAccUnitBI = Nothing
End Sub

Private Sub Clear(tre As MSComctlLib.TreeView)
    Tree_Initialize tre
End Sub

Private Sub JackSize_Initialize()
    maxLeft = 6600
    minLeft = 210
End Sub

Private Sub treSel_Collapse(ByVal Node As MSComctlLib.Node)
    Node.Image = 1
End Sub

Private Sub treSel_Expand(ByVal Node As MSComctlLib.Node)
    Node.Image = 2
End Sub

Private Sub treUnSel_Collapse(ByVal Node As MSComctlLib.Node)
    Node.Image = 1
End Sub

Private Sub treUnSel_Expand(ByVal Node As MSComctlLib.Node)
    Node.Image = 2
End Sub