📄 rtj.frm
字号:
Else
sql = "'"
For jj = 0 To li - 2
sql = sql & Trim(List2.List(jj)) & "','"
Next
sql = sql & Trim(List2.List(li - 1)) & "'"
End If
Label2.Caption = Format(DTPicker1.Value, "yyyy年m月d日") & "汽运销售报表"
sj1 = Format(DTPicker1.Value, "yyyy-mm-dd")
Adodc1.ConnectionTimeout = 15
Adodc1.ConnectionString = connetstr
Adodc1.RecordSource = " SELECT htk.fhdw AS 发货单位,htk.hth as 票号, htk.htl AS 开票数量,htk.sj AS 开票时间, htk.hwm AS 煤种, SUM(" _
& jl_sqlstr & ".jz) AS 今日发运量, htk.yfl AS 累计发量, htk.wfl AS 欠存量 FROM " _
& jl_sqlstr & " INNER JOIN htk ON htk.hth = " & jl_sqlstr & ".hth where " _
& jl_sqlstr & ".sj like'%" & sj1 & "%' and " & jl_sqlstr & ".hth in (" _
& hths & ") group BY htk.fhdw,htk.bz, htk.hth, htk.htl, htk.hwm, htk.yfl," _
& "htk.wfl, htk.sj "
Debug.Print Adodc1.RecordSource
Adodc1.refresh
Set MSHFlexGrid1.DataSource = Adodc1
MSHFlexGrid1.refresh
Me.neuoutput.Enabled = True
Call js
' Adodc1.ConnectionString = ""
End Sub
Private Sub exit_Click()
Unload Me
End Sub
'##################################################################
'## 过程名称:Form_Load
'## 参数: 无
'##################################################################
Private Sub Form_Load()
On Error Resume Next
Me.Adodc2.ConnectionString = connetstr
Me.Adodc3.ConnectionString = connetstr
MSHFlexGrid1.Rows = 30
DTPicker1.Value = Now
headle = 2
Dim jj
Dim llen
Adodc3.refresh
llen = Adodc3.Recordset.RecordCount
For jj = 0 To llen - 1
List1.AddItem Adodc3.Recordset.Fields(0)
Adodc3.Recordset.MoveNext
Next jj
With Me.MSHFlexGrid1
.Row = 0
.ColWidth(0) = 200
.ColWidth(1) = 2400
.ColWidth(2) = 1000
.ColWidth(3) = 1000
.ColWidth(4) = 1000
.ColWidth(5) = 1000
.ColWidth(6) = 1000
.ColWidth(7) = 1000
.ColWidth(8) = 1000
.ColWidth(9) = 1000
.ColWidth(10) = 1000
.ColWidth(11) = 1000
End With
Me.Adodc1.ConnectionString = connetstr
Me.Adodc1.RecordSource = "SELECT htk.fhdw AS 发货单位, htk.htl AS 开票数量, htk.sj AS 开票时间, htk.hwm AS 煤种, SUM(" & jl_sqlstr & ".jz) AS 今日发运量, htk.yfl AS 累计发量, htk.wfl AS 欠存量, " & jl_sqlstr & ".dhdd AS 到货地点, " & jl_sqlstr & ".fhr AS 发货人, bz AS 备注 FROM " & jl_sqlstr & " INNER JOIN htk ON " & jl_sqlstr & ".hth = htk.hth where " & jl_sqlstr & ".zfjl >0 GROUP BY " & jl_sqlstr & ".dhdd,htk.bz,htk.fhdw, " & jl_sqlstr & ".fhr, htk.hth, htk.htl, htk.hwm, htk.yfl, htk.wfl, htk.sj"
Me.Adodc1.refresh
End Sub
'##################################################################
'## 过程名称:Form_Resize
'## 参数: 无
'##################################################################
Private Sub Form_Resize()
On Error Resume Next
MSHFlexGrid1.Width = Me.Width - 400
'MSHFlexGrid1.Height = Me.Height - 2800
Label2.Width = Me.Width
Picture1.Width = Me.Width - Picture1.Left * 2
Me.CurtPrinter1.Move 0, 0, Me.Width, Me.Height
End Sub
'##################################################################
'## 过程名称:Form_Unload
'## 参数:Cancel 为Integer型
'##################################################################
Private Sub Form_Unload(Cancel As Integer)
headle = 0
If CurtPrinter1.Busy = True Then '打印预览控件忙则取消打印任务,然后就可以退出了
CurtPrinter1.CancelPrint
MsgBox "打印控件忙,稍后重试。", vbInformation
Cancel = True
End If
'
End Sub
'##################################################################
'## 过程名称:List1_Click
'## 参数: 无
'##################################################################
Private Sub List1_Click()
listindex1 = List1.ListIndex
End Sub
'##################################################################
'## 过程名称:List2_Click
'## 参数: 无
'##################################################################
Private Sub List2_Click()
listindex2 = List2.ListIndex
End Sub
'##################################################################
'## 过程名称:PrintContent
'## 参数:Optional 为ntDevice As Printer型
'##################################################################
Public Sub PrintContent(Optional PrintDevice As Printer)
Const TableStartX = 10
If PrintDevice Is Nothing Then
CurtPrinter1.StartPrint toPreview '预览
Else
CurtPrinter1.StartPrint toPrinter '打印到打印机
End If
Dim strr
With CurtPrinter1
'重新开始一页,直接打印报表,注意,它会自动换页,如果你设定了标题,它也自动打哦:)
.NewPage
'直接打印MSHFlexGrid
.DirectPrint MSHFlexGrid1, Label2.Caption
'FromDirectPrint MSHFlexGrid1, "FromDirectPrint--MSFlexGrid控件内容,表格起始水平坐标为10", , , 10
strr = Str(Val(Format(Val(Text1.Text) / 1000, "00000000000.000")))
.TextOut Label3.Caption & Space(10) & DataCombo1.Text
' & Space(50) & Label4.Caption & Space(6) & strr & "吨"
'结束打印
.EndDoc
End With
End Sub
'##################################################################
'## 过程名称:mnuExit_Click
'## 参数: 无
'##################################################################
Private Sub mnuExit_Click()
Me.CurtPrinter1.Visible = False
End Sub
'预览的代码
'##################################################################
'## 过程名称:mnuPreview_Click
'## 参数: 无
'##################################################################
Private Sub mnuPreview_Click()
CurtPrinter1.Visible = True
mnuManual.Enabled = True
PrintContent
End Sub
'两行代码可选,一个会调用打印对话框,一个直接打印了。
'##################################################################
'## 过程名称:mnuPrint_Click
'## 参数: 无
'##################################################################
Private Sub mnuPrint_Click()
'CurtPrinter1.ShowPrinter
PrintContent Printer
End Sub
'点击了预览控件上的关闭,引发该事件,关闭预览窗体
'##################################################################
'## 过程名称:curtprinter1_ClosePreview
'## 参数: 无
'##################################################################
Private Sub curtprinter1_ClosePreview()
CurtPrinter1.Visible = False
mnuManual.Enabled = False
End Sub
'如果每次调整预览比例好重新生成预览的话,请将AutoRedraw设置为FALSE,然后在下面的事件添入要重画的代码
'##################################################################
'## 过程名称:curtprinter1_NeedRedraw
'## 参数: 无
'##################################################################
Private Sub CurtPrinter1_NeedRedraw()
PrintContent
End Sub
'写入打印叶脚的代码
'##################################################################
'## 过程名称:CurtPrinter1_PrintFooter
'## 参数:CurrentPage 为Long型
'## 参数:LeftText 为String型
'## 参数:CenterText 为String型
'## 参数:RightText 为String型
'##################################################################
Private Sub CurtPrinter1_PrintFooter(CurrentPage As Long, LeftText As String, CenterText As String, RightText As String)
'LeftText = jl_zgdw
CenterText = Format(Now, "yyyy年m月d日")
RightText = "其他信息"
End Sub
'写入打印页眉的代码
'##################################################################
'## 过程名称:CurtPrinter1_PrintHeader
'## 参数:CurrentPage 为Long型
'## 参数:LeftText 为String型
'## 参数:CenterText 为String型
'## 参数:RightText 为String型
'##################################################################
Private Sub CurtPrinter1_PrintHeader(CurrentPage As Long, LeftText As String, CenterText As String, RightText As String)
LeftText = Date
CenterText = jl_qym
RightText = "这是第 " & CurrentPage & " 页"
End Sub
'点击了预览窗体或直接调用ShowPrinter后,点击了打印机窗口的确定,引发打印代码,打印到打印机上!
'##################################################################
'## 过程名称:curtprinter1_RealPrint
'## 参数: 无
'##################################################################
Private Sub curtprinter1_RealPrint()
PrintContent Printer
End Sub
'如果隐藏工具条,仍可以通过简单的编程控制预览
'##################################################################
'## 过程名称:mnuPageDown_Click
'## 参数: 无
'##################################################################
Private Sub mnuPageDown_Click()
CurtPrinter1.PageDown
End Sub
'##################################################################
'## 过程名称:mnuPageSetup_Click
'## 参数: 无
'##################################################################
Private Sub mnuPageSetup_Click()
CurtPrinter1.PageSetup
End Sub
'##################################################################
'## 过程名称:mnuPageUp_Click
'## 参数: 无
'##################################################################
Private Sub mnuPageUp_Click()
CurtPrinter1.PageUp
End Sub
'##################################################################
'## 过程名称:mnuZoom_Click
'## 参数: 无
'##################################################################
Private Sub mnuZoom_Click()
CurtPrinter1.Zoom = Val(InputBox("请输入0-200之间的数字")) '0代表整页预览
End Sub
'##################################################################
'## 过程名称:mnuOrientation_Click
'## 参数: 无
'##################################################################
Private Sub mnuOrientation_Click()
CurtPrinter1.Orientation = IIf(CurtPrinter1.Orientation = 1, 2, 1)
End Sub
'##################################################################
'## 过程名称:mnuPaperSize_Click
'## 参数: 无
'##################################################################
Private Sub mnuPaperSize_Click()
CurtPrinter1.PaperSize = InputBox("请输入打印纸型号:")
End Sub
'复制字体属性
'##################################################################
'## 过程名称:CloneFont
'## 参数:Dest 为StdFont型
'## 参数:Src 为StdFont型
'##################################################################
Private Sub CloneFont(Dest As StdFont, Src As StdFont)
With Dest
.Bold = Src.Bold
.Charset = Src.Charset
.Italic = Src.Italic
.Name = Src.Name
.Size = Src.Size
.Strikethrough = Src.Strikethrough
.Underline = Src.Underline
.Weight = Src.Weight
End With
End Sub
Private Sub js()
On Error Resume Next
Dim cols1
Dim rows1
Dim je, i, jryl
Dim ljje
Dim yfl, wfl, htl
Dim pjje
Dim ljjryl
Dim ljhtl
Dim ljyfl
Dim ljwfl
'clos1 = datPrimaryRS.Recordset.Fields.Count
rows1 = Adodc1.Recordset.RecordCount
Adodc1.Recordset.MoveFirst
Debug.Print rows1
For i = 1 To rows1
jryl = jryl + Adodc1.Recordset.Fields(5) / 1000
ljhtl = ljhtl + Adodc1.Recordset.Fields(2) / 1000
yfl = yfl + Adodc1.Recordset.Fields(6) / 1000
wfl = wfl + Adodc1.Recordset.Fields(7) / 1000
Adodc1.Recordset.MoveNext
Next i
With Me.MSHFlexGrid1
.Rows = rows1 + 2
.Row = rows1 + 1
.Col = 1
.Text = "合计(吨)"
.Col = 3
.Text = ljhtl
.Col = 6
.Text = jryl
.Col = 7
.Text = yfl
.Col = 8
.Text = wfl
End With
End Sub
Private Sub neuoutput_Click()
On Error Resume Next
Dim filename As String
Dim filenanmber As Integer
Dim jj As Integer
Dim ii As Integer
filenanmber = FreeFile
Me.CommonDialog1.Filter = "*.txt|*.txt"
Me.CommonDialog1.ShowOpen
If Me.CommonDialog1.filename <> "" Then
Open Me.CommonDialog1.filename For Output As #filenanmber
Call Command9_Click
Me.Adodc1.refresh
Me.Adodc1.Recordset.MoveFirst
For ii = 0 To 10
Print #filenanmber, Me.Adodc1.Recordset.Fields(ii).Name, ";",
Next ii
Print #filenanmber, Chr(13)
For jj = 1 To Me.Adodc1.Recordset.RecordCount
For ii = 0 To 10
Print #filenanmber, Me.Adodc1.Recordset.Fields(ii), ";",
Next ii
Print #filenanmber, Chr(10)
Me.Adodc1.Recordset.MoveNext
Next jj
Close #filenanmber
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -