系统_打印基本模块.bas

适合于中小型企业管理

    Rsbj.Open "Xt_PrintSize", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdTable
    ' Print two test pages to confirm the page size.
    Printer.FontSize = 12
    Printer.Print "测试页 1. - 南通易博科技资讯有限公司"
        For i = 0 To 43
            Printer.CurrentX = Rsbj.Fields(i) * Printer.Width * 1
            Printer.CurrentY = Rsbj.Fields(44 + i) * Printer.Height * 1
            Printer.Print i & "测"
        Next i
    'Printer.NewPage '测试第2页
    ' Spacing between lines should reflect the chosen page height.
    'Printer.Print "测试页 2. - 南通易博科技资讯有限公司"
    '   For i = 0 To 43
    '        Printer.CurrentX = Rsbj.Fields(i) * Printer.Width * 1
    '        Printer.CurrentY = Rsbj.Fields(44 + i) * Printer.Height * 1
    '        Printer.Print i & "测"
    '    Next i
    Printer.EndDoc
    MsgBox "Check Printer " & Printer.DeviceName, vbInformation, "Done!"
    Exit Sub
Errline:
    MsgBox err.Description, vbExclamation, "错误代码：" & err.Number
End Sub


Public Sub PrintTest1()
On Error GoTo Errline
    Dim SQLtxt As String
    Dim i As Integer
    Dim X As String
    Dim MoneyStr As String
    Dim Rsbj As ADODB.Recordset
    Dim RsView1 As ADODB.Recordset
    Dim RsView2 As ADODB.Recordset
    Dim Arr(45) As String
    Dim CmdExe As ADODB.Command
    Dim RkStr As String
    
    If FLCount = 1 Then
            RkStr = Frm实施采购.RKTxt.Text
    ElseIf FLCount = 2 Then
            RkStr = Frm出库登记.RKTxt.Text
    End If
    Set Rsbj = New ADODB.Recordset
    Rsbj.Open "Xt_PrintSize", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdTable
If FLCount = 1 Then
    '数据库搜索语句，找出打印数据项
        Set RsView1 = New ADODB.Recordset
        RsView1.Open "SELECT *  FROM Fl_采购票据表 where 票据编号='" & RkStr & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
     If RsView1.EOF And RsView1.BOF Then
        MsgBox "此票据没有添加任何采购信息！", vbExclamation, "票据不可用："
        Exit Sub
    End If
    '============================================================================
    '打印内容设置
            Arr(0) = "NO." & Frm实施采购.RKTxt.Text
            Arr(1) = Frm实施采购.Text5.Text
            Arr(2) = Date
            Arr(3) = Frm实施采购.combo1.Text
            i = 0
        Do While Not RsView1.EOF
            Set RsView2 = New ADODB.Recordset
            RsView2.Open "SELECT *  FROM Fl_物资信息表 where 物资编号='" & Trim(RsView1!物资编号) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly, adCmdText
            Arr(4 + i * 8) = RsView2!物资编号
            Arr(5 + i * 8) = RsView2!物资名称
            Arr(6 + i * 8) = RsView2!物资型号
            Arr(7 + i * 8) = RsView2!计量单位
            RsView2.Close
            Arr(8 + i * 8) = RsView1!数量
            Arr(9 + i * 8) = RsView1!单价
            Arr(10 + i * 8) = RsView1!金额
            Arr(11 + i * 8) = RsView1!备注
            RsView1.MoveNext
            i = i + 1
        Loop
    '============================================================================
    ' Print two test pages to confirm the page size.
            For i = 0 To 43
                Printer.FontSize = 10
                Printer.CurrentX = Rsbj.Fields(i) * Printer.Width * 1
                Printer.CurrentY = Rsbj.Fields(44 + i) * Printer.Height * 1
                Printer.Print Arr(i)
            Next i
            
    '开始新页打印任务
    Printer.EndDoc
            '打印状态
            Set CmdExe = New ADODB.Command
            CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
            CmdExe.CommandText = "update Fl_采购票据表 set 打印状态= '" & 1 & "' where 票据编号='" & RkStr & "'"
            CmdExe.Execute
            '票据打印信息
            Set CmdExe = New ADODB.Command
            CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
            CmdExe.CommandText = "INSERT INTO Fl_票据信息表(票据编号,票据类型,备注) VALUES ('" & RkStr & "', '采购','" & "首次打印：" & Date & "')"
            CmdExe.Execute
    MsgBox "输出到打印机 " & Printer.DeviceName, vbInformation, "完成！"
ElseIf FLCount = 2 Then
    '数据库搜索语句，找出打印数据项
        Set RsView1 = New ADODB.Recordset
        RsView1.Open "SELECT *  FROM FL_辅料出库表 where 票据编号='" & RkStr & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
     If RsView1.EOF And RsView1.BOF Then
        MsgBox "此票据没有添加任何出库信息！", vbExclamation, "票据不可用："
        Exit Sub
    End If
    '============================================================================
    '打印内容设置
            Arr(0) = "NO." & Frm出库登记.RKTxt.Text
            Arr(1) = Frm出库登记.Combo2.Text
            Arr(2) = Date
            Arr(3) = Frm出库登记.combo1.Text
        Do While Not RsView1.EOF
            Set RsView2 = New ADODB.Recordset
            RsView2.Open "SELECT *  FROM Fl_物资信息表 where 物资编号='" & Trim(RsView1!物资编号) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly, adCmdText
            Arr(4 + i * 8) = RsView2!物资编号
            Arr(5 + i * 8) = RsView2!物资名称
            Arr(6 + i * 8) = RsView2!物资型号
            Arr(7 + i * 8) = RsView2!计量单位
            RsView2.Close
            Arr(8 + i * 8) = RsView1!数量
            Arr(9 + i * 8) = RsView1!单价
            Arr(10 + i * 8) = RsView1!金额
            Arr(11 + i * 8) = RsView1!备注
            RsView1.MoveNext
            i = i + 1
        Loop
    '============================================================================
    ' Print two test pages to confirm the page size.
            For i = 0 To 43
                Printer.FontSize = 10
                Printer.CurrentX = Rsbj.Fields(i) * Printer.Width * 1
                Printer.CurrentY = Rsbj.Fields(44 + i) * Printer.Height * 1
                Printer.Print Arr(i)
            Next i
            
    '开始新页打印任务
    Printer.EndDoc
            Set CmdExe = New ADODB.Command
            CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
            CmdExe.CommandText = "update FL_辅料出库表 set 打印状态= '" & 1 & "' where 票据编号='" & RkStr & "'"
            CmdExe.Execute
            '票据打印信息
            Set CmdExe = New ADODB.Command
            CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
            CmdExe.CommandText = "INSERT INTO Fl_票据信息表(票据编号,票据类型,备注) VALUES ('" & RkStr & "', '出库','" & "首次打印：" & Date & "')"
            CmdExe.Execute
        
    MsgBox "输出到打印机 " & Printer.DeviceName, vbInformation, "完成！"
End If
    Exit Sub
Errline:
    MsgBox err.Description, vbExclamation, "错误代码：" & err.Number
End Sub

Public Sub PrintTest2()
On Error GoTo Errline
    Dim SQLtxt As String
    Dim i As Integer
    Dim X As String
    Dim MoneyStr As String
    Dim Rsbj As ADODB.Recordset
    Dim RsView1 As ADODB.Recordset
    Dim RsView2 As ADODB.Recordset
    Dim Arr(45) As String
    Dim CmdExe As ADODB.Command
    Dim RkStr As String
    Dim dyxx As Integer
    
    If PrintFL = 1 Then
            RkStr = Frm票据审核.RKTxt.Text
    ElseIf PrintFL = 2 Then
            RkStr = Frm票据查询.RKTxt.Text
    End If
    Set Rsbj = New ADODB.Recordset
    Rsbj.Open "Xt_PrintSize", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdTable
If PrintFL = 1 Then
    '数据库搜索语句，找出打印数据项
        Set RsView1 = New ADODB.Recordset
        RsView1.Open "SELECT *  FROM Fl_采购票据表 where 票据编号='" & RkStr & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
     If RsView1.EOF And RsView1.BOF Then
        MsgBox "此票据没有添加任何采购信息！", vbExclamation, "票据不可用："
        Exit Sub
    End If
    '============================================================================
    '打印内容设置
            Arr(0) = "NO." & RkStr
            Arr(1) = RsView1!供货单位
            Arr(2) = Date
            Arr(3) = RsView1!仓库名称
            dyxx = RsView1!打印状态
            i = 0
        Do While Not RsView1.EOF
            Set RsView2 = New ADODB.Recordset
            RsView2.Open "SELECT *  FROM Fl_物资信息表 where 物资编号='" & Trim(RsView1!物资编号) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly, adCmdText
            Arr(4 + i * 8) = RsView2!物资编号
            Arr(5 + i * 8) = RsView2!物资名称
            Arr(6 + i * 8) = RsView2!物资型号
            Arr(7 + i * 8) = RsView2!计量单位
            RsView2.Close
            Arr(8 + i * 8) = RsView1!数量
            Arr(9 + i * 8) = RsView1!单价
            Arr(10 + i * 8) = RsView1!金额
            Arr(11 + i * 8) = RsView1!备注
            RsView1.MoveNext
            i = i + 1
        Loop
    '============================================================================
    ' Print two test pages to confirm the page size.
            For i = 0 To 43
                Printer.FontSize = 10
                Printer.CurrentX = Rsbj.Fields(i) * Printer.Width * 1
                Printer.CurrentY = Rsbj.Fields(44 + i) * Printer.Height * 1
                Printer.Print Arr(i)
            Next i
            
    '开始新页打印任务
    Printer.EndDoc
            '打印状态
            '票据打印信息
            If dyxx = 0 Then
                Set CmdExe = New ADODB.Command
                CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
                CmdExe.CommandText = "update Fl_采购票据表 set 打印状态= '" & 1 & "' where 票据编号='" & RkStr & "'"
                CmdExe.Execute
                Set CmdExe = New ADODB.Command
                CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
                CmdExe.CommandText = "INSERT INTO Fl_票据信息表(票据编号,票据类型,备注) VALUES ('" & RkStr & "', '采购','" & "首次打印：" & Date & "')"
                CmdExe.Execute
            Else
                Set CmdExe = New ADODB.Command
                CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
                CmdExe.CommandText = "update Fl_票据信息表 set 重印=a.重印+1, 备注=a.备注 + '；'+ CONVERT(varchar(16),getDate()) FROM Fl_票据信息表 as a WHERE 票据类型='采购' and 票据编号='" & RkStr & "'"
                CmdExe.Execute
            End If
    MsgBox "输出到打印机 " & Printer.DeviceName, vbInformation, "完成！"
ElseIf PrintFL = 2 Then
    '数据库搜索语句，找出打印数据项
        Set RsView1 = New ADODB.Recordset
        RsView1.Open "SELECT *  FROM FL_辅料出库表 where 票据编号='" & RkStr & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
     If RsView1.EOF And RsView1.BOF Then
        MsgBox "此票据没有添加任何出库信息！", vbExclamation, "票据不可用："
        Exit Sub
    End If
    '============================================================================
    '打印内容设置
            Arr(0) = "NO." & RkStr
            Arr(1) = RsView1!部门名称
            Arr(2) = Date
            Arr(3) = RsView1!仓库名称
            dyxx = RsView1!打印状态
            i = 0
        Do While Not RsView1.EOF
            Set RsView2 = New ADODB.Recordset
            RsView2.Open "SELECT *  FROM Fl_物资信息表 where 物资编号='" & Trim(RsView1!物资编号) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly, adCmdText
            Arr(4 + i * 8) = RsView2!物资编号
            Arr(5 + i * 8) = RsView2!物资名称
            Arr(6 + i * 8) = RsView2!物资型号
            Arr(7 + i * 8) = RsView2!计量单位
            RsView2.Close
            Arr(8 + i * 8) = RsView1!数量
            Arr(9 + i * 8) = RsView1!单价
            Arr(10 + i * 8) = RsView1!金额
            Arr(11 + i * 8) = RsView1!备注
            RsView1.MoveNext
            i = i + 1
        Loop
    '============================================================================
    ' Print two test pages to confirm the page size.
            For i = 0 To 43
                Printer.FontSize = 10
                Printer.CurrentX = Rsbj.Fields(i) * Printer.Width * 1
                Printer.CurrentY = Rsbj.Fields(44 + i) * Printer.Height * 1
                Printer.Print Arr(i)
            Next i
            
    '开始新页打印任务
    Printer.EndDoc
            '票据打印信息
            If dyxx = 0 Then
                Set CmdExe = New ADODB.Command
                CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
                CmdExe.CommandText = "update FL_辅料出库表 set 打印状态= '" & 1 & "' where 票据编号='" & RkStr & "'"
                CmdExe.Execute
                Set CmdExe = New ADODB.Command
                CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
                CmdExe.CommandText = "INSERT INTO Fl_票据信息表(票据编号,票据类型,备注) VALUES ('" & RkStr & "', '出库','" & "首次打印：" & Date & "')"
                CmdExe.Execute
            Else
                Set CmdExe = New ADODB.Command
                CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
                CmdExe.CommandText = "update Fl_票据信息表 set 重印=a.重印+1 , 备注=a.备注 + '；'+ CONVERT(varchar(16),getDate()) FROM Fl_票据信息表 as a WHERE 票据类型='出库' and 票据编号='" & RkStr & "'"
                CmdExe.Execute
            End If
    MsgBox "输出到打印机 " & Printer.DeviceName, vbInformation, "完成！"
End If
    Exit Sub
Errline:
    MsgBox err.Description, vbExclamation, "错误代码：" & err.Number
End Sub

Function daxie(money As String) As String '
Dim X As String, Y As String
Dim i As Integer
Const letter = "0123456789" '定义汉字缩写
Const upcase = "零壹贰叁肆伍陆柒捌玖" '定义大写汉字
Dim Temp As String
Temp = money
If InStr(Temp, ".") > 0 Then Temp = Left(Temp, InStr(Temp, ".") - 1)

If Len(Temp) > 16 Then MsgBox "数目太大，无法换算！请输入一亿亿以下的数字", 64, "错误提示": Exit Function '只能转换一亿亿元以下数目的货币！

X = Format(money, "0.00") '格式化货币
Y = ""
For i = 1 To Len(X) - 3
Y = Y & Mid(X, i, 1)
Next
 Y = Y & Left(Right(X, 2), 1) & Right(X, 1)


For i = 1 To 19
Y = Replace(Y, Mid(letter, i, 1), Mid(upcase, i, 1)) '大写汉字
Next
daxie = Y
End Function