frmaccinfo.frm

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

Private Sub treStyle_NodeClick(ByVal Node As MSComctlLib.Node)
    
    If NodeKey <> Node.key Then
            NodeKey = Node.key
            Parentkey = ""
    End If
    
    If Len(Node.key) <> 2 Then
        If Len(Node.Parent.key) = 2 Then
            Parentkey = Node.Parent.key
            SetUI1
        Else
            SetUI
        End If
    ElseIf Len(Node.key) = 2 Then
        SetUI2
    End If
    
End Sub

Private Sub SetUI()
    sqlwhere = " fd_accdef.accdef_id='" & mID(NodeKey, 2) & "'"
    Select Case m_ShowDestroy
        Case 1
        
        Case 2
            sqlwhere = sqlwhere & " and bdestroy=0"
        Case 3
            sqlwhere = sqlwhere & " and bdestroy=1"
    End Select
    fillGrid (sqlwhere)
End Sub

Private Sub SetUI1()
    sqlwhere = " fd_accUnit.accunit_id='" & mID(NodeKey, 2) & "'"
    Select Case m_ShowDestroy
        Case 1
        
        Case 2
            sqlwhere = sqlwhere & " and bdestroy=0"
        Case 3
            sqlwhere = sqlwhere & " and bdestroy=1"
    End Select
    fillGrid (sqlwhere)

End Sub

Private Sub SetUI2()
    sqlwhere = " fd_accUnit.itype='" & mID(NodeKey, 2) & "'"
    Select Case m_ShowDestroy
        Case 1
        
        Case 2
            sqlwhere = sqlwhere & " and bdestroy=0"
        Case 3
            sqlwhere = sqlwhere & " and bdestroy=1"
    End Select
    fillGrid (sqlwhere)

End Sub

Private Sub fillGrid(ByVal sqlwhere As String)
    Dim i As Integer
    Dim j As Long
    Dim rs As New UfRecordset
    Dim sqlstrtemp As String
    
    i = 1
    j = 0
    If sqlwhere <> "" Then
        sqlstrtemp = sqlstr & " where " & sqlwhere
    Else
        sqlstrtemp = sqlstr
    End If
    sqlstrtemp = sqlstrtemp & " order by fd_accupgrade.upgrade_date,fd_accupgrade.old_caccid"
    Err.clear
    On Error GoTo Error0
    Set rs = dbsZJ.OpenRecordset(sqlstrtemp, dbOpenSnapshot)
    
    If rs.RecordCount = 0 Then
        initGrid
        GoTo Error0
    End If
    
    With SuperGrid1
        .Rows = rs.RecordCount + 1
        .Cols = show_count
        While Not (rs.EOF Or rs.BOF)
            If m_fields(0).fshow Then
                .TextMatrix(i, j) = Format(IIf(IsNull(rs![upgrade_date]), "", rs![upgrade_date]), "YYYY-MM-DD")
                j = j + 1
            End If
            If m_fields(1).fshow Then
                .TextMatrix(i, j) = IIf(IsNull(rs![old_caccid]), "", rs![old_caccid])
                j = j + 1
            End If
            If m_fields(2).fshow Then
                .TextMatrix(i, j) = IIf(IsNull(rs![new_caccid]), "", rs![new_caccid])
                j = j + 1
            End If
            If m_fields(3).fshow Then
                .TextMatrix(i, j) = IIf(IsNull(rs![cAccName]), "", rs![cAccName])
                j = j + 1
            End If
            If m_fields(4).fshow Then
                .TextMatrix(i, j) = IIf(IsNull(rs![cAccbank]), "", rs![cAccbank])
                j = j + 1
            End If
            If m_fields(5).fshow Then
                .TextMatrix(i, j) = IIf(IsNull(rs![cintrid]), "", rs![cintrid])
                j = j + 1
            End If
            If m_fields(6).fshow Then
                .TextMatrix(i, j) = IIf(IsNull(rs![cCadID]), "", rs![cCadID])
                j = j + 1
            End If
            If m_fields(7).fshow Then
                .TextMatrix(i, j) = IIf(IsNull(rs![digest]), "", rs![digest])
                j = j + 1
            End If
            If m_fields(8).fshow Then
                .TextMatrix(i, j) = Format(IIf(IsNull(rs![deficit_mny]), "", rs![deficit_mny]), "#0.00")
                j = j + 1
            End If
            If m_fields(9).fshow Then
                .TextMatrix(i, j) = IIf(IsNull(rs![cYtID]), "", rs![cYtID])
                j = j + 1
            End If
            If m_fields(10).fshow Then
                .TextMatrix(i, j) = IIf(IsNull(rs![BjKm]), "", rs![BjKm])
                j = j + 1
            End If
            If m_fields(11).fshow Then
                .TextMatrix(i, j) = IIf(IsNull(rs![Yslxkm]), "", rs![Yslxkm])
                j = j + 1
            End If
            If m_fields(12).fshow Then
                .TextMatrix(i, j) = IIf(IsNull(rs![YflxKm]), "", rs![YflxKm])
                j = j + 1
            End If
            If m_fields(13).fshow Then
                .TextMatrix(i, j) = IIf(IsNull(rs![LxsrKm]), "", rs![LxsrKm])
                j = j + 1
            End If
            If m_fields(14).fshow Then
                .TextMatrix(i, j) = IIf(IsNull(rs![LxzcKm]), "", rs![LxzcKm])
                j = j + 1
            End If
            i = i + 1
            j = 0
            rs.MoveNext
        Wend
    End With
Error0:
    If Err.Number <> 0 Then
        MsgBox "数据装载错误！", vbExclamation, "账号信息调整表"
    End If
    Set rs = Nothing
End Sub
Private Sub tlbTool_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.key
        Case "print"
            printProc
        Case "preview"
            previewProc
        Case "output"
            outputProc
        Case "refresh"
            If NodeKey <> "" Then
                If Len(NodeKey) <> 2 Then
                    If Len(Parentkey) = 2 Then
                        SetUI1
                    Else
                        SetUI
                    End If
                ElseIf Len(NodeKey) = 2 Then
                    SetUI2
                End If
            End If
        Case "find"
            If frmQuqeryAccInfo.m_accUpgrade = 0 Then
                frmQuqeryAccInfo.m_accUpgrade = 1
                frmQuqeryAccInfo.Show 1
                frmQuqeryAccInfo.m_accUpgrade = 0
                Call fillGrid(sqlwhere)
            Else
                MsgBox "账号信息调整程序正在执行查询操作！" & vbCrLf & "请稍后再执行查询！", vbInformation, "账号升级"
            End If
        Case "fields"
            frmFields.Show 1
            initGrid
            fillGrid (sqlwhere)
        Case "help"
            SendKeys "{F1 3}"
        Case "exit"
            Unload Me
            Exit Sub
    End Select
    If Button.key <> "exit" Then
        ocxCTBTool.RefreshEnable
    End If

End Sub


'初始化打印数据XML文件
Private Sub initPrnXmlFile()
    '过程变量
    Dim prnxml As New clsPrnXml
    Dim AttrName() As String
    Dim AttrValue() As String
    Dim i, j As Integer
    Dim str1 As String
    
    On Error GoTo Error0
    
    '插入结构数据数据
    str1 = "账号调整历史记录"
    prnxml.Initialize "数据", "任务"
    prnxml.InsertPNode "任务", "页眉", "第%p页，共%p页"
    prnxml.InsertPNode "任务", "标题", str1
    prnxml.InsertPNode "任务", "表头", ""
    prnxml.InsertPNode "任务", "表体", ""
    prnxml.InsertPNode "任务", "表尾", ""
    prnxml.InsertPNode "任务", "页脚", "用友软件"
    
    ReDim AttrName(0, 1)
    ReDim AttrValue(0)
    
    '插入表头,表尾数据
    For i = 0 To UBound(AttrName)
        AttrName(i, 0) = "名字"
    Next
    '插入表头,表尾数据
    AttrName(0, 1) = "日期"
    
    AttrValue(0) = CStr(Format(zjLogInfo.curDate, "YYYY-MM-DD"))
    prnxml.InsertHeadNodes "表头", "字段", AttrName, AttrValue
    
    '插入表体头数据
    ReDim AttrName(show_count - 1, 1)
    ReDim AttrValue(show_count - 1)
    For i = 0 To show_count - 1
        AttrName(i, 0) = "单元"
        AttrValue(i) = Trim(SuperGrid1.TextMatrix(0, i))
    Next
'    AttrValue(0) = "新账户号"
'    AttrValue(1) = "旧账户号"
'    AttrValue(2) = "账户名称"
'    AttrValue(3) = "单位名称"
'    AttrValue(4) = "开户日期"
'    AttrValue(5) = "开户银行"
'    AttrValue(6) = "币别"
    prnxml.InsertBodyNodes "表体", "表体头", AttrName, AttrValue
    For i = 0 To show_count - 1
        AttrValue(i) = ""
    Next
    
    '插入表体行数据
'    Dim j As Integer
     With SuperGrid1
        For i = 1 To .Rows - 1
            For j = 0 To show_count - 1
                AttrValue(j) = .TextMatrix(i, j)
            Next
            prnxml.InsertBodyNodes "表体", "表体行", AttrName, AttrValue
        Next
'            AttrValue(0) = .TextMatrix(i, 1)
'            AttrValue(1) = .TextMatrix(i, 0)
'            AttrValue(2) = .TextMatrix(i, 2)
'            AttrValue(3) = .TextMatrix(i, 3)
'            AttrValue(4) = .TextMatrix(i, 4)
'            AttrValue(5) = .TextMatrix(i, 5)
'            AttrValue(5) = .TextMatrix(i, 6)
'        Next
    End With
    '保存数据文件
    prnxml.saveFile "taccInfoData.xml"
    If initStyleXml Then
        If prnDataBind Then
            xmlInit = True
        Else
            xmlInit = False
        End If
    Else
        xmlInit = False
    End If
    Set prnxml = Nothing
    Exit Sub
Error0:
    MsgBox "打印数据准备失败！" & vbCrLf & Err.Description, vbInformation, "错误信息"
'    If rs.State = adStateOpen Then
'        rs.Close
'    End If
    xmlInit = False
    Set prnxml = Nothing
End Sub

Private Function prnDataBind() As Boolean
    Dim lRet As Long
    Dim sData As String
    Dim sStyle As String
    Dim sModuleId As String
    
    sData = App.Path & "\taccInfoData.xml"
    sStyle = App.Path & "\taccInfoStyle.xml"
    sModuleId = "default"
    lRet = Printer.SetDataStyleXML(sData, 1, sStyle, 1, sModuleId)
    If lRet = 0 Then
        prnDataBind = True
    Else
        prnDataBind = False
        MsgBox "打印数据准备失败！", vbInformation, "错误信息"