📄 printcode.frm
字号:
ButtonWidth = 1984
ButtonHeight = 1005
Style = 1
TextAlignment = 1
ImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 1
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "输出"
ImageIndex = 1
EndProperty
EndProperty
End
End
End
Attribute VB_Name = "PrintCode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
OpenMdb
Call CreaDZB
Adodc1.ConnectionString = "DBQ=" & App.Path & "\Data\eletricity.Mdb" & ";Driver={Microsoft Access Driver (*.mdb)};DriverId=281;FIL=MS Access;MaxBufferSize=2048;MaxScanRows=8;PageTimeout=5;PWD=;SafeTransactions=0;Threads=3;UID=admin;UserCommitSync=Yes;"
Adodc1.RecordSource = "SELECT A AS 表码1,B AS 辅助号1,C AS 名称1,AA AS 表码2,BB AS 辅助号2,CC AS 名称2,AAA AS 表码3,BBB AS 辅助号3,CCC AS 名称3 FROM 对照表" '"SELECT 用户表码,辅助号,用户名称 FROM 用户电费 WHERE 镇村代码='" & UserSeek & "'"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
With DataGrid1
.Columns(0).Width = 1000
.Columns(0).Alignment = dbgCenter
.Columns(1).Width = 1000
.Columns(1).Alignment = dbgCenter
.Columns(2).Width = 1000
.Columns(2).Alignment = dbgCenter
.Columns(3).Width = 1000
.Columns(3).Alignment = dbgCenter
.Columns(4).Width = 1000
.Columns(4).Alignment = dbgCenter
.Columns(5).Width = 1000
.Columns(5).Alignment = dbgCenter
.Columns(6).Width = 1000
.Columns(6).Alignment = dbgCenter
.Columns(7).Width = 1000
.Columns(7).Alignment = dbgCenter
.Columns(8).Width = 1000
.Columns(8).Alignment = dbgCenter
End With
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
If Option1.Value = False Then
Call StartCellPrint
Else
Call FileCrea
End If
End Sub
Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
Unload Me
End Sub
Sub StartCellPrint()
Dim i As Integer
Dim count_user As String
Dim dian_liang As Long
Dim dian_fei As Double
Dim head_title As String
Dim zong_user As Long
Dim users As Long
Dim total_page As Integer
Dim mydb As New ADODB.Connection
'─││┆┈┄┆┊┌┐└┘├┤┬┴┼╱╲「」
On Error GoTo hander
dian_fei = 0#
dian_liang = 0
count_user = 0
zong_user = 0
users = 0
Screen.MousePointer = 11
head_title = XcName & "抄表代码对照表(专供杭州NX-3型抄表器使用)"
total_page = (Adodc1.Recordset.RecordCount + 28) / 28
Call printer_init
Call printer_string(0, 0, Space(30) & head_title)
'─││┆┈┄┆┊┌┐└┘├ ┤┬ ┴ ┼╱╲「」
Printer.Print Space(5) & "抄表员:" & Space(15) & Space(32) & "共" & IIf(total_page = 0, total_page + 1, total_page - 1) & "页"
Printer.Print "┌──┬───┬────────┬──┬───┬────────┬──┬───┬────────┐"
Printer.Print "│表码│辅助号│ 用 户 名 称 │表码│辅助号│ 用 户 名 称 │表码│辅助号│用 户 名 称 │"
Printer.Print "├──┼───┼────────┼──┼───┼────────┼──┼───┼────────┤"
For i = 0 To Adodc1.Recordset.RecordCount - 1
If count_user < 28 Then
With Adodc1
Printer.Print "│" & Left(.Recordset.Fields("A") & Space(12), 4) & "│" & Left(.Recordset.Fields("B") & Space(8), 6) & "│" & Left(Trim(.Recordset.Fields("C")) & Space(20), 16 - convert_str(Trim(.Recordset.Fields("C")))) & "│" & Left(.Recordset.Fields("AA") & Space(12), 4) & "│" & Left(.Recordset.Fields("BB") & Space(8), 6) & "│" & Left(Trim(.Recordset.Fields("CC")) & Space(20), 16 - convert_str(Trim(.Recordset.Fields("CC")))) & "│" & Left(.Recordset.Fields("AAA") & Space(12), 4) & "│" & Left(.Recordset.Fields("BBB") & Space(8), 6) & "│" & Left(Trim(.Recordset.Fields("CCC")) & Space(20), 16 - convert_str(Trim(.Recordset.Fields("CCC")))) & "│"
Printer.Print "├──┼───┼────────┼──┼───┼────────┼──┼───┼────────┤"
count_user = count_user + 1
End With
Else
With Adodc1
Printer.Print "│" & Left(.Recordset.Fields("A") & Space(12), 4) & "│" & Left(.Recordset.Fields("B") & Space(8), 6) & "│" & Left(Trim(.Recordset.Fields("C")) & Space(20), 16 - convert_str(Trim(.Recordset.Fields("C")))) & "│" & Left(.Recordset.Fields("AA") & Space(12), 4) & "│" & Left(.Recordset.Fields("BB") & Space(8), 6) & "│" & Left(Trim(.Recordset.Fields("CC")) & Space(20), 16 - convert_str(Trim(.Recordset.Fields("CC")))) & "│" & Left(.Recordset.Fields("AAA") & Space(12), 4) & "│" & Left(.Recordset.Fields("BBB") & Space(8), 6) & "│" & Left(Trim(.Recordset.Fields("CCC")) & Space(20), 16 - convert_str(Trim(.Recordset.Fields("CCC")))) & "│"
Printer.Print "└──┴───┴────────┴──┴───┴────────┴──┴───┴────────┘"
count_user = count_user + 1
Printer.Print Space(5) & "本页户数:" & count_user * 3 & Space(20) & "第" & Printer.Page & "页"
Printer.NewPage
count_user = 0
Call printer_string(0, 0, Space(23) & head_title)
Printer.Print Space(5) & "抄表员:" & Space(15) & Space(32) & "共" & IIf(total_page = 0, total_page + 1, total_page - 1) & "页"
Printer.Print "┌──┬───┬────────┬──┬───┬────────┬──┬───┬────────┐"
Printer.Print "│表码│辅助号│ 用 户 名 称 │表码│辅助号│ 用 户 名 称 │表码│辅助号│用 户 名 称 │"
Printer.Print "├──┼───┼────────┼──┼───┼────────┼──┼───┼────────┤"
End With
End If
'此处加入换页代码
If Not Adodc1.Recordset.EOF Then
Adodc1.Recordset.MoveNext
End If
Next
With Adodc1
Printer.Print "│" & Left(.Recordset.Fields("A") & Space(12), 4) & "│" & Left(.Recordset.Fields("B") & Space(8), 6) & "│" & Left(Trim(.Recordset.Fields("C")) & Space(20), 16 - convert_str(Trim(.Recordset.Fields("C")))) & "│" & Left(.Recordset.Fields("AA") & Space(12), 4) & "│" & Left(.Recordset.Fields("BB") & Space(8), 6) & "│" & Left(Trim(.Recordset.Fields("CC")) & Space(20), 16 - convert_str(Trim(.Recordset.Fields("CC")))) & "│" & Left(.Recordset.Fields("AAA") & Space(12), 4) & "│" & Left(.Recordset.Fields("BBB") & Space(8), 6) & "│" & Left(Trim(.Recordset.Fields("CCC")) & Space(20), 16 - convert_str(Trim(.Recordset.Fields("CCC")))) & "│"
Printer.Print "└──┴───┴────────┴──┴───┴────────┴──┴───┴────────┘"
count_user = count_user + 1
' Printer.Print " ────────────────────────────────────────────────────────; """
Printer.Print Space(5) & "本页户数:" & count_user * 3 & Space(20) & "第" & Printer.Page & "页"
End With
Printer.EndDoc
Screen.MousePointer = 0
MsgBox "打印完毕！", vbInformation
Exit Sub
hander:
If Err.Number = 482 Then
MsgBox "打印机错误!", vbCritical
Screen.MousePointer = 0
Exit Sub
Else
Resume Next
End If
End Sub
Sub CreaDZB()
Dim i As Integer
Dim mb As Recordset
Dim II As Integer
On Error Resume Next
Set MdbR = NdMd.OpenRecordset("SELECT 用户电费.用户表码,用户电费.用户名称,用户电费.辅助号,用户电费.组合编码,用户电费.镇村代码 From 用户电费 WHERE 用户电费.镇村代码='" & UserSeek & "'order by 用户电费.组合编码 asc")
NdMd.Execute "DELETE * From 对照表"
Set mb = NdMd.OpenRecordset("对照表")
II = 1
For i = 0 To MdbR.RecordCount - 1
If II = 4 Then II = 1
If II = 1 Then
With mb
.AddNew
.Fields!A = MdbR.Fields!用户表码
.Fields!B = MdbR.Fields!辅助号
.Fields!C = MdbR.Fields!用户名称
End With
End If
If II = 2 Then
With mb
.Fields!AA = MdbR.Fields!用户表码
.Fields!BB = MdbR.Fields!辅助号
.Fields!CC = MdbR.Fields!用户名称
End With
End If
If II = 3 Then
With mb
.Fields!AAA = MdbR.Fields!用户表码
.Fields!BBB = MdbR.Fields!辅助号
.Fields!CCC = MdbR.Fields!用户名称
.Update
End With
End If
MdbR.MoveNext
II = II + 1
Next
End Sub
Sub FileCrea()
Dim FileExcel As String
FileExcel = Trim(XcName) & "电表标签.xls"
If FileExists("c:\My Documents\" & FileExcel) Then
If MsgBox(FileExcel & "文件已存在，是否覆盖？(Y/N)", vbYesNo + 32) = vbYes Then
Kill "c:\My Documents\" & FileExcel
Call CreaDZB
NdMd.Execute "SELECT 对照表.A AS 表码1,对照表.B AS 辅助号1,对照表.C AS 户名1,对照表.AA AS 表码2,对照表.BB as 辅助号2,对照表.CC as 户名2 ,对照表.AAA as 表码3,对照表.BBB as 辅助号3," _
& "对照表.CCC as 户名3 INTO [Excel 8.0;DATABASE=c:\My Documents\" & FileExcel & "].[对照表] FROM 对照表"
MsgBox XcName & "用户电表标签已生成,存放在C:\My Documents\下,文件名为:" & FileExcel, vbInformation
End If
Else
NdMd.Execute "SELECT 对照表.A AS 表码1,对照表.B AS 辅助号1,对照表.C AS 户名1,对照表.AA AS 表码2,对照表.BB as 辅助号2,对照表.CC as 户名2 ,对照表.AAA as 表码3,对照表.BBB as 辅助号3," _
& "对照表.CCC as 户名3 INTO [Excel 8.0;DATABASE=c:\My Documents\" & FileExcel & "].[对照表] FROM 对照表"
MsgBox XcName & "用户电表标签已生成,存放在C:\My Documents\下,文件名为:" & FileExcel, vbInformation
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -