📄 printfeelist.frm
字号:
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 = "打印"
Object.ToolTipText = "全部打印所有用户"
ImageIndex = 1
EndProperty
EndProperty
End
Begin VB.Label Label2
Caption = "至表号第"
Height = 255
Left = 195
TabIndex = 3
Top = 810
Width = 735
End
Begin VB.Label Label1
Caption = "从表号第"
Height = 255
Left = 150
TabIndex = 2
Top = 225
Width = 735
End
End
Begin VB.Label Label13
BackColor = &H8000000B&
Caption = $"PrintFeeList.frx":EBB6
ForeColor = &H00404040&
Height = 870
Left = 1830
TabIndex = 13
Top = 3690
Width = 6090
End
End
Attribute VB_Name = "PrintFeeList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim FileFormat As Integer
Dim FileTxt As String, FileExcel As String, FileHtml As String
Dim NewTable As TableDef
Dim DfRec As Recordset, Nan2Rec As Recordset
Dim BiaoZhi As Integer
Dim dianliang As Long
Dim dianfei As Currency
Dim shishou As Currency
Dim yingshou As Currency
Private Sub Form_Load()
Dim hs As String, dl As String, df As String
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
FWCheck1.Value = False
FWCheck2.Value = False
Combo1.Enabled = False
OpenMdb
DoEvents
Set MdbR = NdMd.OpenRecordset("SELECT 用户电费.镇村代码,sum(" & BBB & ") AS 上期电量,sum(" & CCC & ") AS 上期电费,sum(" & CC & ") AS 本月电量,sum(" & DD & ") AS 总电量,sum(" & GG & ") AS 本月电费,sum(" & HH & ") AS 总电费,COUNT(*) AS 用户数 From 用户电费 where 用户电费.镇村代码 ='" & UserSeek & "' GROUP BY 用户电费.镇村代码")
If MdbR.RecordCount = 0 Then
MsgBox "无用户档案，请建立！", vbInformation
Unload Me
Exit Sub
End If
With MdbR
Label14 = .Fields!用户数
Label15 = .Fields!本月电量
Label16 = Format(.Fields!本月电费, "0.00")
Label18 = .Fields!上期电量
Label19 = Format(.Fields!上期电费, "0.00")
Label21 = .Fields!总电量
Label22 = Format(.Fields!总电费, "0.00")
End With
'Set MdbR = NdMd.OpenRecordset("SELECT 用户电费.抄表码,用户电费.全称,用户电费.[" & AAA & "] AS 上期示数, 用户电费.[" & AA & "] AS 本期示数,用户电费.倍率,用户电费.[" & BB & "] AS 调整电量,用户电费.[" & CC & "] AS 本次电量, 用户电费.[" & DD & "] AS 合计电量,用户电费.电价,用户电费.[" & EE & "] AS 调整金额, 用户电费.[" & FF & "] AS 滞纳金, 用户电费.[" & GG & "] AS 本次电费, 用户电费.[" & HH & "] AS 合计电费,用户电费.[" & II & "] AS 代扣信息,用户电费.[" & JJ & "] AS 发票打印,用户电费.[" & KK & "] AS 交费情况,用户电费.组合编码 From 用户电费 WHERE 用户电费.镇村代码='" & UserSeek & "' order by 用户电费.组合编码 asc")
Me.Caption = "打印电费公布栏"
Screen.MousePointer = 0
ProgressBar1.Visible = False
On Error Resume Next
FileFormat = GetSetting(App.EXEName, "PrintSetup", "Filemat", "")
FileTxt = Trim(XcName) & Mid(Year(Date), 3, 2) & Format(Month(Date), "0#") & "电费清单.Doc"
FileExcel = Trim(XcName) & Mid(Year(Date), 3, 2) & Format(Month(Date), "0#") & "电费清单.xls"
FileHtml = Trim(XcName) & Mid(Year(Date), 3, 2) & Format(Month(Date), "0#") & "电费清单.Html"
Combo1.AddItem "Text文本文件"
Combo1.AddItem "Excel电子表格"
Combo1.AddItem "Html文件"
Combo1.ListIndex = IIf(FileFormat = 0, 0, FileFormat)
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
SaveSetting App.EXEName, "PrintSetup", "Filemat", Combo1.ListIndex
NdMd.Close
End Sub
Private Sub FWCheck2_Click()
If FWCheck2.Value = 1 Then
Combo1.Enabled = True
Else
Combo1.Enabled = False
End If
End Sub
Private Sub Text1_Change()
Call CheckIsNumber(Text1)
End Sub
Private Sub Text2_Change()
Call CheckIsNumber(Text2)
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
If FWCheck2 Then '输出到文件
Call OutFile
Else '输出到打印机
Call OutPrint
End If
End Sub
Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
Unload Me
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
'If Chr(KeyAscii) Like "[!0-9]" Then KeyAscii = 0
If KeyAscii = 13 Then
If Len(Text1) <> 0 And IsStringNumeric(Text1) = 0 Then
Label2.Visible = True
Text2.Visible = True
Text2.SetFocus
End If
End If
End Sub
Private Sub Text2_keyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If IsStringNumeric(Text1) = 0 Then
If Val(Text2) < Val(Text1) Then
MsgBox "结束表号小于开始表号", vbCritical
Label2.Visible = False
Text2 = ""
Text2.Visible = False
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
Text1.SetFocus
Else
If FWCheck2 Then '输出到文件
Call OutFile
Else '输出到打印机
Call OutPrint
End If
End If
Else
MsgBox "结束表号输入非法!", vbCritical
Text2.SelStart = 0
Text2.SelLength = Len(Text2)
Text2.SetFocus
End If
End If
End Sub
'输出到文件
Sub OutFile()
Screen.MousePointer = 11
Select Case Combo1.ListIndex
Case 0 'text
If FileExists("C:\My Documents\" & FileTxt) Then
If MsgBox(FileTxt & "文件已存在，是否覆盖？(Y/N)", vbYesNo + 32) = vbYes Then
Kill "C:\My Documents\" & FileTxt
If Text1 <> "" And Text2 <> "" Then
Call OutText(1)
Else
Call OutText(2)
End If
Else
Screen.MousePointer = 0
Exit Sub
End If
Else
If Text1 <> "" And Text2 <> "" Then
Call OutText(1)
Else
Call OutText(2)
End If
End If
Case 1 'excel
If FileExists("C:\My Documents\" & FileExcel) Then
If MsgBox(FileExcel & "文件已存在，是否覆盖？(Y/N)", vbYesNo + 32) = vbYes Then
Kill "C:\My Documents\" & FileExcel
If Text1 <> "" And Text2 <> "" Then
Call OutExcel(1)
Else
Call OutExcel(2)
End If
Else
Screen.MousePointer = 0
Exit Sub
End If
Else
If Text1 <> "" And Text2 <> "" Then
Call OutExcel(1)
Else
Call OutExcel(2)
End If
End If
Case 2 'html
If FileExists("C:\My Documents\" & FileHtml) Then
If MsgBox(FileHtml & "文件已存在，是否覆盖？(Y/N)", vbYesNo + 32) = vbYes Then
Kill "C:\My Documents\" & FileHtml
If Text1 <> "" And Text2 <> "" Then
Call OutHtml(1)
Else
Call OutHtml(2)
End If
Else
Screen.MousePointer = 0
Exit Sub
End If
Else
If Text1 <> "" And Text2 <> "" Then
Call OutHtml(1)
Else
Call OutHtml(2)
End If
End If
End Select
MsgBox "文件成功生成！", vbInformation
Screen.MousePointer = 0
' Exit Sub
End Sub
'输出到打印机
Sub OutPrint()
If FWCheck1 Then '表格输出
If Text1 <> "" And Text2 <> "" Then '判断是否选择输出
Call PriType(1)
Call StartCellPrint
Else
Call PriType(2)
Call StartCellPrint
End If
Else '无表格输出
If Text1 <> "" And Text2 <> "" Then '判断是否选择输出
Call PriType(1)
Call StartNoCellPrint
Else
Call PriType(2)
Call StartNoCellPrint
End If
End If
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -