mdlzhangjf.bas

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

Attribute VB_Name = "mdlZhangjf"
'--------------------------------
'时间:2002.03.04
'版权:北京用友软件股份有限公司
'设计:章景峰
'编码:章景峰
'说明:U8资金管理---新增模块定义
'--------------------------------

Public Function GetAccBalance(AccCode As String, dDate As Date) As Double
    Dim objEO       As U8FDEso.EntityObject
    Dim objAccDefBI As New U8FDBso.clsAccDefBI
    
    frmRzhye.strAccID = AccCode
    frmRzhye.datDate = dDate
    Set objEO = objAccDefBI.FindByCode(g_sDataSourceName, AccCode)
    frmRzhye.iDataSource = objEO("datasrc_flag").Value
    frmRzhye.PrepareData True
    GetAccBalance = frmRzhye.dzdMb
    Set objEO = Nothing
    Set objAccDefBI = Nothing
End Function

Public Function TaskExec(cAcc_Id As String, cUser_Id As String, cAuth_Id As String, iYear As Integer) As Boolean
    Dim con As New adodb.Connection
    Dim rec As New adodb.Recordset
    Dim sql As String
    
    con.Open g_sMenuDSN
    sql = "select count(*) from UA_HoldAuth where cAuth_id like 'FD%' and cAcc_Id='" & cAcc_Id & "' and cUser_Id='" & cUser_Id & "' and cAuth_Id like '" & cAuth_Id & "%' and iYear=" & iYear
    rec.Open sql, con, adOpenDynamic, adLockReadOnly
    If rec.Fields(0) > 0 Then
        TaskExec = True
    Else
        TaskExec = False
    End If
    rec.Close
    con.Close
    Set rec = Nothing
    Set con = Nothing
End Function

Public Function GetReplyNum() As Integer
    Dim con As New adodb.Connection
    Dim rec As New adodb.Recordset
    con.Open g_sDataSourceName
    rec.Open "select reply_num from fd_option", con, adOpenDynamic, adLockReadOnly
    If Not rec.EOF Then
        GetReplyNum = IIf(IsNumeric(rec.Fields(0)), rec.Fields(0), 10)
    Else
        GetReplyNum = 0
    End If
    rec.Close
    con.Close
    Set rec = Nothing
    Set con = Nothing
End Function

Public Function PzSign(PzCode As String) As Boolean
    Dim con As New adodb.Connection
    Dim rec As New adodb.Recordset
    con.Open g_sDataSourceName
    rec.Open "select csign,ctext from dsign where csign='" & PzCode & "'", con, adOpenDynamic, adLockReadOnly
    If Not rec.EOF Then
        PzSign = True
    Else
        PzSign = False
    End If
    rec.Close
    con.Close
    Set rec = Nothing
    Set con = Nothing
End Function

Public Function MoneyIsExist(Name As String) As Boolean
    Dim arrCurr As Variant

    MoneyIsExist = False
    arrCurr = GetAllCurrencyNames
    For i = 0 To UBound(arrCurr) - 1
        If Name = arrCurr(i) Then
            MoneyIsExist = True
            Exit Function
        End If
    Next
End Function

Public Function SettleIsExist(Name As String) As String
    Dim con As New adodb.Connection
    Dim rec As New adodb.Recordset
    Dim sql As String
    
    SettleIsExist = ""
    con.Open g_sDataSourceName
    sql = "select cSSCode,cSSName from SettleStyle where bSSEnd=1 and (cSSCode='" & Name & "' or cSSName='" & Name & "') order by [cSScode]"
    rec.Open sql, con, adOpenDynamic
    With rec
        If Not rec.EOF Then
            SettleIsExist = rec.Fields(0)
        End If
    End With
    Set rec = Nothing
    Set con = Nothing
End Function

Public Function SubjectIsExist(Name As String, Optional CodeName As String) As String
    Dim con As New adodb.Connection
    Dim rec As New adodb.Recordset
    Dim sql As String
    
    SubjectIsExist = ""
    con.Open g_sDataSourceName
    sql = "select ccode,ccode_name from code where bend=1 and (ccode='" & Name & "' or ccode_name='" & Name & "') order by [ccode]"
    rec.Open sql, con, adOpenDynamic
    With rec
        If Not rec.EOF Then
            SubjectIsExist = rec.Fields(0)
            CodeName = rec.Fields(1)
        End If
    End With
    Set rec = Nothing
    Set con = Nothing
End Function

Public Function GetExchangeSymbol(wbName As String) As Boolean
    Dim objWbProperties As New ZzPub.clsWbProperties
    aClsPub.wbNameToProperties wbName, objWbProperties
    GetExchangeSymbol = objWbProperties.bcal
    'If objWbProperties.bcal Then
    '    GetExchangeSymbol = True
    'Else
    '    GetExchangeSymbol = False
    'End If
    Set objWbProperties = Nothing
End Function

'初始化工具栏
Public Sub MSImageList_Initialize(ImgLst As Object)
    Dim imgX As MsComctlLib.ListImage
    With ImgLst
        Set imgX = .ListImages.Add(, "Print", LoadResPicture(314, vbResBitmap))
        Set imgX = .ListImages.Add(, "Preview", LoadResPicture(312, vbResBitmap))
        Set imgX = .ListImages.Add(, "Dataout", LoadResPicture(263, vbResBitmap))
        Set imgX = .ListImages.Add(, "Export", LoadResPicture(263, vbResBitmap))
        Set imgX = .ListImages.Add(, "add", LoadResPicture(323, vbResBitmap))
        Set imgX = .ListImages.Add(, "AddNew", LoadResPicture(323, vbResBitmap))
        Set imgX = .ListImages.Add(, "Edit", LoadResPicture(324, vbResBitmap))
        Set imgX = .ListImages.Add(, "del", LoadResPicture(326, vbResBitmap))
        Set imgX = .ListImages.Add(, "Delete", LoadResPicture(326, vbResBitmap))
        Set imgX = .ListImages.Add(, "Cancel", LoadResPicture(316, vbResBitmap))
        Set imgX = .ListImages.Add(, "free", LoadResPicture(353, vbResBitmap))
        Set imgX = .ListImages.Add(, "find", LoadResPicture(309, vbResBitmap))
        Set imgX = .ListImages.Add(, "Find", LoadResPicture(331, vbResBitmap))
        Set imgX = .ListImages.Add(, "help", LoadResPicture(396, vbResBitmap))
        Set imgX = .ListImages.Add(, "Help", LoadResPicture(396, vbResBitmap))
        Set imgX = .ListImages.Add(, "exit", LoadResPicture(1118, vbResBitmap))
        Set imgX = .ListImages.Add(, "Exit", LoadResPicture(1118, vbResBitmap))
        Set imgX = .ListImages.Add(, "tree", LoadResPicture(1111, vbResBitmap))
        Set imgX = .ListImages.Add(, "seltree", LoadResPicture(1112, vbResBitmap))
        Set imgX = .ListImages.Add(, "leaf", LoadResPicture(1128, vbResBitmap))
        Set imgX = .ListImages.Add(, "leafsel", LoadResPicture(1129, vbResBitmap))
        Set imgX = .ListImages.Add(, "destroy", LoadResPicture(1105, vbResBitmap))
        Set imgX = .ListImages.Add(, "Destroy", LoadResPicture(1105, vbResBitmap))
        Set imgX = .ListImages.Add(, "import", LoadResPicture(364, vbResBitmap))
        Set imgX = .ListImages.Add(, "Import", LoadResPicture(364, vbResBitmap))
        Set imgX = .ListImages.Add(, "add1", LoadResPicture(343, vbResBitmap))
        Set imgX = .ListImages.Add(, "del1", LoadResPicture(347, vbResBitmap))
        'Set imgX = .ListImages.Add(, "cut", LoadResPicture(317, vbResBitmap))
        Set imgX = .ListImages.Add(, "copy", LoadResPicture(318, vbResBitmap))
        Set imgX = .ListImages.Add(, "Copy", LoadResPicture(318, vbResBitmap))
        Set imgX = .ListImages.Add(, "paste", LoadResPicture(319, vbResBitmap))
        Set imgX = .ListImages.Add(, "Paste", LoadResPicture(319, vbResBitmap))
        Set imgX = .ListImages.Add(, "save", LoadResPicture(1145, vbResBitmap))
        Set imgX = .ListImages.Add(, "Save", LoadResPicture(1145, vbResBitmap))
        Set imgX = .ListImages.Add(, "calc", LoadResPicture(372, vbResBitmap))
        Set imgX = .ListImages.Add(, "refresh", LoadResPicture(154, vbResBitmap))
        Set imgX = .ListImages.Add(, "Refresh", LoadResPicture(154, vbResBitmap))
        Set imgX = .ListImages.Add(, "switch", LoadResPicture(226, vbResBitmap))
        Set imgX = .ListImages.Add(, "ColumnSet", LoadResPicture(102, vbResBitmap))
        Set imgX = .ListImages.Add(, "bill", LoadResPicture(1102, vbResBitmap))
        Set imgX = .ListImages.Add(, "Pz", LoadResPicture(143, vbResBitmap))
        Set imgX = .ListImages.Add(, "First", LoadResPicture(1174, vbResBitmap))
        Set imgX = .ListImages.Add(, "Previous", LoadResPicture(1139, vbResBitmap))
        Set imgX = .ListImages.Add(, "Next", LoadResPicture(1133, vbResBitmap))
        Set imgX = .ListImages.Add(, "Last", LoadResPicture(1117, vbResBitmap))
        Set imgX = .ListImages.Add(, "Check", LoadResPicture(1100, vbResBitmap))
        Set imgX = .ListImages.Add(, "CancelCheck", LoadResPicture(144, vbResBitmap))
        Set imgX = .ListImages.Add(, "BatchCheck", LoadResPicture(105, vbResBitmap))
        Set imgX = .ListImages.Add(, "BatchCancel", LoadResPicture(106, vbResBitmap))
        Set imgX = .ListImages.Add(, "Grouping", LoadResPicture(1128, vbResBitmap))
        Set imgX = .ListImages.Add(, "Freeze", LoadResPicture(353, vbResBitmap))
        Set imgX = .ListImages.Add(, "ShowDestroy", LoadResPicture(888, vbResBitmap))
        Set imgX = .ListImages.Add(, "Approve", LoadResPicture(324, vbResBitmap))
        Set imgX = .ListImages.Add(, "SelAll", LoadResPicture(207, vbResBitmap))
        Set imgX = .ListImages.Add(, "UnSelAll", LoadResPicture(208, vbResBitmap))
        Set imgX = .ListImages.Add(, "Ratio", LoadResPicture(364, vbResBitmap))
    End With
End Sub
Public Function SetPrintDataXML(sql As String, Optional PrintTitle As String, Optional PrintTypeList As String, Optional PrintSizeList As String) As String
    Dim i           As Integer
    Dim lRet        As Long
    Dim sData       As String
    Dim sStyle      As String
    Dim sModuleId   As String
    Dim con         As New adodb.Connection
    Dim rec         As New adodb.Recordset
    
    On Error GoTo lblHandle
    Dim objDom      As New DOMDocument
    Dim xmlNode     As IXMLDOMNode
    Dim currNode    As IXMLDOMNode
    Dim tempNode    As IXMLDOMNode
    Dim unitNode    As IXMLDOMNode
    
    If InStr(1, sql, ",transactions_id as 内部业务ID") > 0 Then Mid(sql, InStr(1, sql, ",transactions_id as 内部业务ID"), Len(",transactions_id as 内部业务ID")) = String(Len(",transactions_id as 内部业务ID"), " ")
    If InStr(1, sql, ",fd_accdef.accdef_id as 账户ID") > 0 Then Mid(sql, InStr(1, sql, ",fd_accdef.accdef_id as 账户ID"), Len(",fd_accdef.accdef_id as 账户ID")) = String(Len(",fd_accdef.accdef_id as 账户ID"), " ")
    sData = "<?xml version='1.0' standalone='yes' ?><数据/>"
    objDom.loadXML sData
    Set xmlNode = objDom.createNode(NODE_ELEMENT, "任务", "")
    
    Set currNode = objDom.createNode(NODE_ELEMENT, "页眉", "")
    xmlNode.appendChild currNode
    currNode.Text = ZjAccInfo.zjZtUnitName
    
    Set currNode = objDom.createNode(NODE_ELEMENT, "标题", "")
    xmlNode.appendChild currNode
    currNode.Text = PrintTitle
    
    Set currNode = objDom.createNode(NODE_ELEMENT, "表头", "")