单位批量输入.frm

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

End Sub

Private Sub load_data(trv As TreeView)

    Dim itmX As Node
    Dim Code As String
    Dim Name As String
    Dim iType As Byte
    Dim pKey As String
    Dim rsUnit As New UfRecordset
        
    Set rsUnit = dbsZJ.OpenRecordset("FD_AccUnit", dbOpenSnapshot)
    With rsUnit
        While Not .EOF
            Code = !cUnitCode
            Name = !cUnitName
            iType = !iType
            Select Case iType
              Case 0
                pKey = "p"
              Case 1
                pKey = "d"
              Case 2
                pKey = "b"
              Case 3
                pKey = "c"
              Case 4
                pKey = "s"
              Case 5
                pKey = "i"
            End Select
            Set itmX = trv.Nodes.Add(pKey, tvwChild, pKey & Code, Code & Chr(9) & Name, "leaf", "leafsel")
            itmX.Sorted = True
            .MoveNext
        Wend
    End With
    
End Sub

Private Sub DataInput(iType As Integer)

    Dim sql As String
    Dim rsl As New UfRecordset
    
    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
    lvSel(OldIndex - 1).ListItems.Clear
    ListView_Load lvUnSel(OldIndex - 1), sql
    set_lvunsel_null_false OldIndex - 1
    
End Sub

Private Sub ListView_Load(lsv As ListView, sql As String)
    
    Dim rsl As New UfRecordset, rsl1 As New UfRecordset
    Dim itmX As ListItem
    On Error Resume Next
    
    lsv.ListItems.Clear
    If Right(sql, 5) = "class" Then
        Set rsl1 = dbsZJ.OpenRecordset(sql, dbOpenSnapshot)
        With rsl1
            While Not .EOF
'                Set rsl = dbsZJ.OpenRecordset("select '" & rsl1!citem_class & "' & [citemcode] as zd1,[citemname] from fitemss" & rsl1!citem_class & " order by [citemcode]", dbOpenSnapshot) 'Cuidong 2000/08/02
                Set rsl = dbsZJ.OpenRecordset("select '" & rsl1!citem_class & "' + [citemcode] as zd1,[citemname] from fitemss" & rsl1!citem_class & " order by [citemcode]", dbOpenSnapshot)  'Cuidong 2000/08/02
                If Err.Number <> 0 Then GoTo nextab
                With rsl
                    While Not .EOF
                        ListView_AddItem lsv, .Fields(0).Value, .Fields(1).Value
                        .MoveNext
                    Wend
                    .oClose
                End With
nextab:         .MoveNext
            Wend
            .oClose
        End With
    Else
        Set rsl = dbsZJ.OpenRecordset(sql, dbOpenSnapshot)
        With rsl
            While Not .EOF
                ListView_AddItem lsv, .Fields(0).Value, .Fields(1).Value
                .MoveNext
            Wend
            .oClose
        End With
    End If
End Sub

Private Sub ListView_AddItem(lsv As ListView, Para1 As String, para2 As String)

    Dim itmX As ListItem
    
    With lsv
        Set itmX = .ListItems.Add(, , Para1, , "tree")
        itmX.SubItems(1) = para2
    End With
    
End Sub

Private Sub JackResize1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> vbLeftButton Then Exit Sub
drag = True
startx = JackResize1.Left
End Sub

Private Sub JackResize1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If drag Then
  If X + JackResize1.Left > maxleft Or X + JackResize1.Left < minleft Then Exit Sub
  JackResize1.Move X + JackResize1.Left
End If
End Sub

Private Sub JackResize1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button <> vbLeftButton Then Exit Sub
  drag = False
  endx = JackResize1.Left
  Label1.Width = Label1.Width + endx - startx
  tvSel.Width = tvSel.Width + endx - startx
  Label2.Left = Label2.Left - startx + endx
  Label2.Width = Label2.Width + startx - endx
  tvUnSel.Left = tvUnSel.Left - startx + endx
  tvUnSel.Width = tvUnSel.Width + startx - endx
End Sub

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

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

Private Sub TabStrip1_Click()

    Dim i
    
    With TabStrip1
        Select Case .SelectedItem.key
            Case "p"
                If OldIndex <> 1 Then
                    bk(OldIndex - 1).Visible = False
                    bk(0).Visible = True
                End If
            Case "d"
                If OldIndex <> 2 Then
                    bk(OldIndex - 1).Visible = False
                    bk(1).Visible = True
                End If
            Case "b"
                If OldIndex <> 3 Then
                    bk(OldIndex - 1).Visible = False
                    bk(2).Visible = True
                End If
            Case "c"
                If OldIndex <> 4 Then
                    bk(OldIndex - 1).Visible = False
                    bk(3).Visible = True
                End If
            Case "s"
                If OldIndex <> 5 Then
                    bk(OldIndex - 1).Visible = False
                    bk(4).Visible = True
                End If
            Case "i"
                If OldIndex <> 6 Then
                    bk(OldIndex - 1).Visible = False
                    bk(5).Visible = True
                End If
        End Select
        OldIndex = .SelectedItem.Index
    End With
    
End Sub

Private Sub GenYr()

    Dim i
    
    'tvUnSel.Nodes.Clear
    LsvYrTrv lvSel(0), tvUnSel, "p"
    set_lvsel_null_true 0
    LsvYrTrv lvSel(1), tvUnSel, "d"
    set_lvsel_null_true 1
    LsvYrTrv lvSel(2), tvUnSel, "b"
    set_lvsel_null_true 2
    LsvYrTrv lvSel(3), tvUnSel, "c"
    set_lvsel_null_true 3
    LsvYrTrv lvSel(4), tvUnSel, "s"
    set_lvsel_null_true 4
    LsvYrTrv lvSel(5), tvUnSel, "i"
    set_lvsel_null_true 5
    
End Sub



Private Sub set_lvsel_null_true(Index As Integer)

    cmdSel(Index * 4 + 2).Enabled = False
    cmdSel(Index * 4 + 3).Enabled = False
    
End Sub

Private Sub set_lvsel_null_false(Index As Integer)

    cmdSel(Index * 4 + 2).Enabled = True
    cmdSel(Index * 4 + 3).Enabled = True
    
End Sub

Private Sub set_lvunsel_null_false(Index As Integer)

    cmdSel(Index * 4).Enabled = True
    cmdSel(Index * 4 + 1).Enabled = True
    
End Sub

Private Sub set_lvunsel_null_true(Index As Integer)

    cmdSel(Index * 4).Enabled = False
    cmdSel(Index * 4 + 1).Enabled = False
    
End Sub

Private Sub LsvYrTrv(lsv As ListView, trv As TreeView, key As String)

    Dim nodx As Node
    Dim Code As String
    Dim Name As String
    Dim i
    
    For i = 1 To lsv.ListItems.Count
        Code = lsv.ListItems(i).Text
        Name = lsv.ListItems(i).SubItems(1)
        On Error Resume Next
        Set nodx = trv.Nodes.Add(key, tvwChild, key & Code, Code & Chr(9) & Name, "leaf", "leafsel")
        If Err > 0 Then
            If Not YrErrMsg(Code, Name) Then Exit Sub
            On Error GoTo 0
        End If
    Next i
    lsv.ListItems.Clear

End Sub

Private Function YrErrMsg(Code As String, Name As String) As Boolean

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

Private Sub GenSave()

    Dim nodx As Node
    Dim nody As Node
    Dim i As Long
    Dim key As String
    Dim Code As String
    Dim Name As String, TmpRs As New UfRecordset, dbcz As Boolean
    
    On Error Resume Next
    For i = 1 To tvUnSel.Nodes.Count
        If TreeNodeGrade(tvUnSel.Nodes(i).FullPath) = 1 Then
            Set nody = tvUnSel.Nodes(i)
            key = Left(nody.key, 1)
            Code = Left(nody.Text, InStr(1, nody.Text, Chr(9)) - 1)
            Name = mID(nody.Text, InStr(1, nody.Text, Chr(9)) + 1)
            Set TmpRs = dbsZJ.OpenRecordset("select cUnitCode from FD_AccUnit where cUnitCode='" & Code & "'", dbOpenSnapshot)
            With TmpRs
                If .EOF Then
                    dbcz = False
                Else
                    dbcz = True
                End If
                .oClose
            End With
            If dbcz Then
                If Not YrErrMsg(Code, Name) Then
                    Exit Sub
                End If
            Else
                SaveUnit key, Code, Name
                If Err.Number = 0 Then
                    Set nodx = tvSel.Nodes.Add(key, tvwChild, key & Code, Code & Chr(9) & Name, "leaf", "leafsel")
                    nodx.Sorted = True
                End If
            End If
        End If
    Next i
    Tree_Initialize tvUnSel
    
End Sub

Private Sub SaveUnit(key As String, Code As String, Name As String)

    Dim rsUnit As New UfRecordset, iType As Integer
    Select Case key
        Case "p"
            iType = 0
        Case "d"
            iType = 1
        Case "b"
            iType = 2
        Case "c"
            iType = 3
        Case "s"
            iType = 4
        Case "i"
            iType = 5
    End Select
    Set rsUnit = dbsZJ.OpenRecordset("FD_AccUnit", dbOpenDynaset)
    With rsUnit
        .AddNew
        !cUnitCode = Code
        !cUnitName = Name
        !iType = iType
        .Update
    End With

End Sub

Private Sub TreeView_AddNode(tv1 As TreeView, NodeStr As String, Img As String, ImgSel As String)

    
End Sub

Private Sub TreeView_RemoveNode()

End Sub

Private Sub GenClear(tv1 As TreeView)
Tree_Initialize tv1
End Sub

Private Sub Add_Remove_Node(trv1 As TreeView, trv2 As TreeView, Node As Node)

    
End Sub

Private Sub JackSize_Initialize()

    maxleft = 6600
    minleft = 210
    
End Sub