业务通用模块.bas

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

'End Function
'
''得到不同的打印模板,设置不同的页眉、页脚、表头、表尾
''iPrintType:来源（哪个窗体）
''0:frmBudget,  支付单列表
''1:frmPlan,      凭证查询
''2:frmCollection,    查询结果
''3:frmExportList,   日志查询
'Public Function GetPrintModal(iPrintType As Integer, PageHead As String, TableHead As Variant, TableFoot As Variant, PageFoot As String, sErrMsg As String) As Boolean
'    Dim UnitName As String
'
'    On Error GoTo last
'    Select Case iPrintType
'        Case 0
'            ReDim TableHead(1) As Variant
'            ReDim TableFoot(2) As Variant
'
'            gLogin.GetAccInfo 105, UnitName
'
'            TableHead(0) = Array("单位：", UnitName)
'            TableHead(1) = Array("打印日期：", Format(gLogin.curDate, "YYYY年MM月DD日"))
'            TableFoot(0) = Array("单位：", UnitName)
'            TableFoot(1) = Array("操作员：", gUserName)
'            TableFoot(2) = Array("打印日期：", Format(gLogin.curDate, "YYYY年MM月DD日"))
'            PageHead = UnitName
'            PageFoot = "用友软件\n第 %p 页, 共 %P 页"
'
'        Case 1
'
'        Case 2
'
'        Case 3
'
'    End Select
'    GetPrintModal = True
'    Exit Function
'last:
'    sErrMsg = Err.Description
'    GetPrintModal = False
'End Function
'
''得到输出到文件所需要的字段类型和字段长度,要求字段长度小于255?
'Public Function GetExportTypeSize(iModuleType As Integer, strColType As String, strColSize As String, sErrMsg As String) As Boolean
''    Dim i As Integer
''    Dim sizeTemp As String
''    Dim typetemp As String
''
''    On Error GoTo ErrHandler
''    For i = 0 To DGD.Columns.count - 1
''        If DGD.Columns.Item(i).Visible Then
''            sizeTemp = sizeTemp & IIf(rsSource.Fields(DGD.Columns.Item(i).DataField).DefinedSize > 255, "255", rsSource.Fields(DGD.Columns.Item(i).DataField).DefinedSize) & ","
''            typetemp = typetemp & GetDataType(rsSource.Fields(DGD.Columns.Item(i).DataField).Type) & ","
''        End If
''    Next i
''
''    sizeTemp = left(sizeTemp, Len(sizeTemp) - 1)    '去掉最后一个逗号
''    typetemp = left(typetemp, Len(typetemp) - 1)
''    strColType = typetemp
''    strColSize = sizeTemp
''    GetExportTypeSize = True
''    Exit Function
''
''ErrHandler:
''    sErrMsg = Err.Description
''    GetExportTypeSize = False
'End Function
'
'
'Public Function GetDataType(EnumDataType As DataTypeEnum) As String
'Dim typetemp As String
'
'Select Case EnumDataType
'    Case adBoolean
'        typetemp = "1"  'dbBoolean
'    Case adTinyInt
'        typetemp = "2" 'dbByte
'    Case adSmallInt
'        typetemp = "3"  'dbInteger
'    Case adInteger
'        typetemp = "4"   'dbLong
'    Case adCurrency
'        typetemp = "5"    'dbCurrency
'    Case adSingle
'        typetemp = "6"   'dbSingle
'    Case adDouble
'        typetemp = "7"   'dbDouble
'    Case adDate, adDBDate
'        typetemp = "8"   'dbDate
'    Case Else
'        typetemp = "10"  'dbText
'End Select
'
'GetDataType = typetemp
'
'End Function
'Public Function PrintGrid(PrintControl As PrintControl, SGD As SuperGrid, iSource As Integer, sTitle As String, iPrintType As Integer, sErrMsg As String, Optional sFieldType As String, Optional sFieldSize As String) As Boolean
''通用打印、预览、输出函数
''输入参数:
''PrintControl:Xml打印控件
''SGD:SuperGrid控件
''iSource:来源（哪个窗体）0:frmPaymentList,1:frmPzQuery,2:frmQryResult,3:frmQryLogShow,4:frmExportList,5:frmSetAccount,6:frmSetUnitInfo,7:frmSetBusinessClass,8:frmSetUserAuthority,9:frmPayUnitClass
''sTitle:打印标题
''iPrintType:打印类型 0:预览 1:打印 2:输出到文件
''sErrMsg:出错信息
''sFieldType: 字段类型 (输出的时候才用)
''sFieldSize: 字段长度 (输出的时候才用)
'
'Dim TableHead() As Variant
'Dim TableFoot() As Variant
'Dim PageHead As String
'Dim PageFoot As String
'Dim strXmlData As String
'Dim strXmlStyle As String
'Dim strStyleFile As String
'Dim lngResult As Long
'
'On Error GoTo ErrHandler
'PrintGrid = False
'Select Case iSource     '根据不同来源选择模板文件
'    Case 0
'        strStyleFile = App.Path & IIf(right(App.Path, 1) = "\", "", "\") & "PaymentList.xml"
'
'    Case 1
'        strStyleFile = App.Path & IIf(right(App.Path, 1) = "\", "", "\") & "PzQuery.xml"
'
'    Case 2
'        strStyleFile = App.Path & IIf(right(App.Path, 1) = "\", "", "\") & "QryResult.xml"
'
'    Case 3
'        strStyleFile = App.Path & IIf(right(App.Path, 1) = "\", "", "\") & "QryLogShow.xml"
'
'    Case 4
'        strStyleFile = App.Path & IIf(right(App.Path, 1) = "\", "", "\") & "ExportList.xml"
'
'    Case 5
'        strStyleFile = App.Path & IIf(right(App.Path, 1) = "\", "", "\") & "SetAccount.xml"
'
'    Case 6
'        strStyleFile = App.Path & IIf(right(App.Path, 1) = "\", "", "\") & "SetUnitInfo.xml"
'
'    Case 7
'        strStyleFile = App.Path & IIf(right(App.Path, 1) = "\", "", "\") & "SetBusinessClass.xml"
'
'    Case 8
'        strStyleFile = App.Path & IIf(right(App.Path, 1) = "\", "", "\") & "SetUserAuthority.xml"
'
'    Case 9
'       strStyleFile = App.Path & IIf(right(App.Path, 1) = "\", "", "\") & "PayUnitClass.xml"
'
'
'End Select
'
'lngResult = GetPrintModal(iSource, PageHead, TableHead, TableFoot, PageFoot, sErrMsg)
'If lngResult = 0 Then sErrMsg = "在设置打印模板时发生如下错误：" & sErrMsg: Exit Function
'
'lngResult = SuperGridToXml(SGD, PageHead, sTitle, TableHead, TableFoot, PageFoot, strXmlData, strXmlStyle)
'If lngResult = 0 Then sErrMsg = "在生成打印数据时发生如下错误：" & sErrMsg: Exit Function
'
'If Len(Dir(strStyleFile)) <> 0 Then    '存在模板文件
'    lngResult = PrintControl.SetDataStyleXML(strXmlData, False, strStyleFile, True, 0)
'    If lngResult <> 0 Then
'        MsgBox "调用模板打印失败，将调用缺省设置。", vbInformation, "打印输出"
'        lngResult = PrintControl.SetDataStyleXML(strXmlData, False, strXmlStyle, False, 0)
'    End If
'Else
'    lngResult = PrintControl.SetDataStyleXML(strXmlData, False, strXmlStyle, False, 0)
'End If
'If lngResult <> 0 Then sErrMsg = "在打印初始化时发生如下错误：" & GetErrStr(lngResult): Exit Function
'
'Select Case iPrintType
'    Case 0  '打印预览
'        lngResult = PrintControl.PrintPreview
'
'    Case 1  '打印
'        lngResult = PrintControl.PrintEx(True)
'
'    Case 2  '输出到文件
'        lngResult = PrintControl.ExportToFile(0, sFieldType, sFieldSize, "", "")
'
'End Select
'
'If lngResult <> 0 Then sErrMsg = "在打印输出时发生如下错误：" & GetErrStr(lngResult): Exit Function
'PrintGrid = True
'Exit Function
'
'ErrHandler:
'sErrMsg = "发生未捕获的错误：" & Err.Description
'Exit Function
'
'End Function
'
'Public Function SuperGridToXml(SGD As SuperGrid, PageHead As String, Title As String, TableHead As Variant, TableFoot As Variant, PageFoot As String, strXmlData As String, strXmlStyle As String) As Boolean
''将SuperGrid中的数据转换为可供打印的Xml串，包括格式串和数据串
''参数：
''Sgd：SuperGrid控件
''PageHead：页眉
''Title：标题
''TableHead：表头字符串数组
''TableFoot：表尾字符串数组
''strXmlData：输出的打印数据串
''StrXmlStyle：输出的格式字符串
''**************************************************************
'
'Dim oXmlData As New DOMDocument
'Dim iXmlDataFoot As IXMLDOMElement
'Dim iXmlDataTask As IXMLDOMElement
'Dim iXmlDataNode As IXMLDOMElement
'Dim iXmlDataTable As IXMLDOMElement
'Dim iXmlDataLeaf As IXMLDOMElement
'
'Dim oXmlStyle As New DOMDocument
'Dim iXmlStyleFoot As IXMLDOMElement
'Dim iXmlStyleNode As IXMLDOMElement
'Dim iXmlStyleLeaf As IXMLDOMElement
'
'Dim i As Integer
'Dim j As Integer
'
'Dim strColWidth As String       '传输各列宽度的字符串
'Dim strAlign As String          '传输各列对齐方式的字符串
'Dim ArrColWidth() As String     '保存各列宽度的数组
'Dim ArrAlign() As String        '保存各列对齐方式的数组
'Dim bHasTblBodyFoot As Boolean  '是否有表体尾
'Dim bSum As Boolean             '是否表体尾已经显示小计
'
'ReDim ArrAlign(0) As String
'ReDim ArrColWidth(0) As String
'For i = 0 To SGD.Cols - 1
'    If InStr(SGD.TextMatrix(0, i), "选择") = 0 Then
'        ArrColWidth(UBound(ArrColWidth)) = CStr(SGD.ColWidth(i) / 5.67)   '转换成0.1mm
'        ReDim Preserve ArrColWidth(UBound(ArrColWidth) + 1) As String
'        If SGD.ColAlignment(i) = 7 Then     '数字和金额右对齐
'            ArrAlign(UBound(ArrAlign)) = "右"
'            bHasTblBodyFoot = True
'        ElseIf SGD.ColAlignment(i) = 4 Then
'            ArrAlign(UBound(ArrAlign)) = "中"
'        Else
'            ArrAlign(UBound(ArrAlign)) = "左"
'        End If
'        ReDim Preserve ArrAlign(UBound(ArrAlign) + 1) As String
'    End If
'Next i
'ReDim Preserve ArrColWidth(UBound(ArrColWidth) - 1)
'strColWidth = Join(ArrColWidth, ",")
'ReDim Preserve ArrAlign(UBound(ArrAlign) - 1)
'strAlign = Join(ArrAlign, ",")
'
'Set iXmlDataFoot = oXmlData.createElement("数据")
'Set oXmlData.documentElement = iXmlDataFoot
'
'Set iXmlStyleFoot = oXmlStyle.createElement("格式")
'Set oXmlStyle.documentElement = iXmlStyleFoot
'
'Set iXmlStyleNode = oXmlStyle.createElement("打印设置")
'iXmlStyleFoot.appendChild iXmlStyleNode
'iXmlStyleNode.setAttribute "打印机", "HP LaserJet 6L"
'iXmlStyleNode.setAttribute "打印范围", "全部"
'iXmlStyleNode.setAttribute "打印份数", "1"
'iXmlStyleNode.setAttribute "压缩", "否"
'iXmlStyleNode.setAttribute "多任务强制分页", "是"
'
'Set iXmlStyleNode = oXmlStyle.createElement("纸张设置")
'iXmlStyleFoot.appendChild iXmlStyleNode
'iXmlStyleNode.setAttribute "纸张类型", "9"
'iXmlStyleNode.setAttribute "纸张大小", "2100,2970"
'iXmlStyleNode.setAttribute "打印方向", "纵向"
'iXmlStyleNode.setAttribute "页边距", "300,200,200,200"
'
'
'Set iXmlDataTask = oXmlData.createElement("任务")
'iXmlDataFoot.appendChild iXmlDataTask
'
'Set iXmlDataNode = oXmlData.createElement("页眉")
'iXmlDataTask.appendChild iXmlDataNode
'iXmlDataNode.Text = PageHead
'
'Set iXmlStyleNode = oXmlStyle.createElement("页眉")
'iXmlStyleFoot.appendChild iXmlStyleNode
'iXmlStyleNode.setAttribute "对齐方式", "左"
'iXmlStyleNode.setAttribute "左顶点", "0,0"
'iXmlStyleNode.setAttribute "宽", "0"
'iXmlStyleNode.setAttribute "高", "100"
'iXmlStyleNode.setAttribute "字体名", "楷体_GB2312"
'iXmlStyleNode.setAttribute "字体大小", "10"
'iXmlStyleNode.setAttribute "颜色", "#99598E"
'
'Set iXmlDataNode = oXmlData.createElement("标题")
'iXmlDataTask.appendChild iXmlDataNode
'iXmlDataNode.Text = Title
'
'Set iXmlStyleNode = oXmlStyle.createElement("标题")
'iXmlStyleFoot.appendChild iXmlStyleNode
'iXmlStyleNode.setAttribute "对齐方式", "中"
'iXmlStyleNode.setAttribute "左顶点", "0,100"
'iXmlStyleNode.setAttribute "宽", "0"
'iXmlStyleNode.setAttribute "高", "100"
'iXmlStyleNode.setAttribute "字体名", "宋体"
'iXmlStyleNode.setAttribute "字体大小", "16"
'iXmlStyleNode.setAttribute "粗体", "是"
'iXmlStyleNode.setAttribute "下划线", "是"
'iXmlStyleNode.setAttribute "颜色", "#008000"
'
'Set iXmlDataNode = oXmlData.createElement("表头")
'iXmlDataTask.appendChild iXmlDataNode
'
'Set iXmlStyleNode = oXmlStyle.createElement("表头")
'iXmlStyleFoot.appendChild iXmlStyleNode
'iXmlStyleNode.setAttribute "字体名", "宋体"
'iXmlStyleNode.setAttribute "字体大小", "10"
'iXmlStyleNode.setAttribute "粗体", "是"
'iXmlStyleNode.setAttribute "颜色", "#800000"
'
'For i = 0 To UBound(TableHead)
'    Set iXmlDataLeaf = oXmlData.createElement("字段")
'    iXmlDataNode.appendChild iXmlDataLeaf
'    If TableHead(i)(0) <> "" Then
'        iXmlDataLeaf.setAttribute "名字", TableHead(i)(0)
'    End If
'    iXmlDataLeaf.Text = TableHead(i)(1)
'
'    Set iXmlStyleLeaf = oXmlStyle.createElement("字段")
'    iXmlStyleNode.appendChild iXmlStyleLeaf
'    iXmlStyleLeaf.setAttribute "名字", TableHead(i)(0)
'    iXmlStyleLeaf.setAttribute "字体名", "宋体"
'    iXmlStyleLeaf.setAttribute "字体大小", "10"
'    If i = UBound(TableHead) Then
'        iXmlStyleLeaf.setAttribute "页面居右", "是"
'        iXmlStyleLeaf.setAttribute "对齐方式", "右"
'    Else
'        iXmlStyleLeaf.setAttribute "对齐方式", "左"
'    End If
'    iXmlStyleLeaf.setAttribute "左顶点", CStr(i * 1000) & ",200"
'    iXmlStyleLeaf.setAttribute "宽", "500"
'    iXmlStyleLeaf.setAttribute "高", "100"
'Next i
'
'Set iXmlDataNode = oXmlData.createElement("表体")
'iXmlDataTask.appendChild iXmlDataNode
'
'Set iXmlStyleNode = oXmlStyle.createElement("表体")
'iXmlStyleFoot.appendChild iXmlStyleNode
'iXmlStyleNode.setAttribute "左顶点", "0,250"
'iXmlStyleNode.setAttribute "宽", "0"
'iXmlStyleNode.setAttribute "高", "0"
'iXmlStyleNode.setAttribute "固定行数", "0"
'iXmlStyleNode.setAttribute "列宽", strColWidth
'
'Set iXmlDataTable = oXmlData.createElement("表体头")
'iXmlDataNode.appendChild iXmlDataTable
'
'Set iXmlStyleLeaf = oXmlStyle.createElement("表体头")
'iXmlStyleNode.appendChild iXmlStyleLeaf
'iXmlStyleLeaf.setAttribute "对齐方式", "中"
'iXmlStyleLeaf.setAttribute "边框风格", "783"
'iXmlStyleLeaf.setAttribute "边框宽度", "2"
'iXmlStyleLeaf.setAttribute "行高", "0"
'iXmlStyleLeaf.setAttribute "字体名", "宋体"
'iXmlStyleLeaf.setAttribute "字体大小", "10"
'iXmlStyleLeaf.setAttribute "粗体", "是"
'iXmlStyleLeaf.setAttribute "颜色", "#0000AA"
'
'For i = 0 To SGD.Cols - 1
'    If InStr(SGD.TextMatrix(0, i), "选择") = 0 Then
'        Set iXmlDataLeaf = oXmlData.createElement("单元")
'        iXmlDataTable.appendChild iXmlDataLeaf
'        iXmlDataLeaf.Text = SGD.TextMatrix(0, i)
'    End If
'Next i
'
'Set iXmlStyleLeaf = oXmlStyle.createElement("表体行")
'iXmlStyleNode.appendChild iXmlStyleLeaf
'iXmlStyleLeaf.setAttribute "对齐方式", strAlign
'iXmlStyleLeaf.setAttribute "边框风格", "783"
'iXmlStyleLeaf.setAttribute "边框宽度", "2"
'iXmlStyleLeaf.setAttribute "行高", "0"
'iXmlStyleLeaf.setAttribute "字体名", "Times New Roman"
'iXmlStyleLeaf.setAttribute "字体大小", "10"
'iXmlStyleLeaf.setAttribute "颜色", "#007EBB"
'
'For i = 1 To SGD.Rows - 1
'    Set iXmlDataTable = oXmlData.createElement("表体行")
'    iXmlDataNode.appendChild iXmlDataTable
'    For j = 0 To SGD.Cols - 1
'        If InStr(SGD.TextMatrix(0, j), "选择") = 0 Then
'            Set iXmlDataLeaf = oXmlData.createElement("单元")
'            iXmlDataTable.appendChild iXmlDataLeaf
'            iXmlDataLeaf.Text = SGD.TextMatrix(i, j)
'        End If
'    Next j
'Next i
'