📄 frmreport.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmReport
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "汇总结算"
ClientHeight = 6825
ClientLeft = 45
ClientTop = 435
ClientWidth = 11895
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 7913.043
ScaleMode = 0 'User
ScaleWidth = 11895
Begin VB.CommandButton cmdAllView
Caption = "预览结算单"
Height = 328
Left = 5400
TabIndex = 6
Top = 840
Width = 1140
End
Begin VB.CommandButton cmdAllPrint
Caption = "打印结算单"
Height = 328
Left = 7440
TabIndex = 5
Top = 840
Width = 1140
End
Begin VB.CommandButton cmdQuery
Caption = "选择结算记录"
Height = 328
Left = 3240
TabIndex = 4
Top = 840
Width = 1260
End
Begin VB.Frame Frame1
Height = 5295
Left = 360
TabIndex = 1
Top = 1320
Width = 11175
Begin MSComctlLib.ListView lsvTraffic
Height = 4815
Left = 240
TabIndex = 2
Top = 240
Width = 10755
_ExtentX = 18971
_ExtentY = 8493
View = 3
LabelEdit = 1
LabelWrap = 0 'False
HideSelection = 0 'False
AllowReorder = -1 'True
FullRowSelect = -1 'True
_Version = 393217
SmallIcons = "ilst16x16"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
End
Begin VB.Label Label2
AutoSize = -1 'True
Height = 180
Left = 9120
TabIndex = 3
Top = 240
Width = 90
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "汇 总 结 算"
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 4320
TabIndex = 0
Top = 240
Width = 3480
End
End
Attribute VB_Name = "frmReport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim total As Integer
Dim totalWeight As Single
Dim totalMony As Single
Dim arrProduct
Dim arrstation
Dim arrclient
Dim strsql As String
Dim DB As New clsDataBase
Private Sub cmdAllPrint_Click()
Dim ir As Integer
Dim strTtaffic As String
ir = 1
For ir = 1 To lsvTraffic.ListItems.Count
If IsNumeric(lsvTraffic.ListItems.Item(ir).Tag) Then
strTtaffic = strTtaffic & sys.TextTolong(lsvTraffic.ListItems.Item(ir).Tag) & ","
End If
Next
If strTtaffic <> "" Then
'取得数据
Dim inum As Integer
Dim isfind As Boolean
Dim strTemp As String
Dim rs As New ADODB.Recordset
strsql = "SELECT * FROM TRAFFIC WHERE ID in (" & Left(strTtaffic, Len(strTtaffic) - 1) & ")"
Set rs = sys.DB.OpenRecordSet(strsql)
If Not rs.EOF Then
Dim wordApp As New Word.Application
Dim mysel As Word.Selection
Dim oTable As Word.Table
wordApp.Documents.Add
wordApp.Visible = True
Set mysel = wordApp.Selection
With mysel
'设置页面
With .PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = CentimetersToPoints(3.17)
.BottomMargin = CentimetersToPoints(3.17)
.LeftMargin = CentimetersToPoints(2.54)
.RightMargin = CentimetersToPoints(2.54)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.5)
.FooterDistance = CentimetersToPoints(1.75)
.PageWidth = CentimetersToPoints(29.7)
.PageHeight = CentimetersToPoints(21)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.GutterPos = wdGutterPosLeft
.LayoutMode = wdLayoutModeLineGrid
End With
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Paragraphs.Last.Range.Font.Bold = True
.Paragraphs.Last.Range.Font.Size = 20
.TypeText Text:="运 输 结 算 单"
.TypeParagraph
.Paragraphs.Last.Range.Font.Size = 10
.Paragraphs.Last.Range.Font.Bold = False
.TypeText Text:="客户： 单位（重量：吨、单价：元）"
.TypeParagraph
.ParagraphFormat.Alignment = wdAlignParagraphCenter
If total <= 15 Then
.Tables.Add Range:=.Range, NumRows:=16, NumColumns:=10, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
Else
.Tables.Add Range:=.Range, NumRows:=total + 1, NumColumns:=10, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitWindow
End If
Set oTable = .Tables(1)
With oTable
.Cell(1, 1).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(1, 1).Range.Text = "序号"
.Cell(1, 2).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(1, 2).Range.Text = "日期"
.Cell(1, 3).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(1, 3).Range.Text = "车号"
.Cell(1, 4).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(1, 4).Range.Text = "发站"
.Cell(1, 5).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(1, 5).Range.Text = "到站"
.Cell(1, 6).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(1, 6).Range.Text = "发货人"
.Cell(1, 7).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(1, 7).Range.Text = "品名"
.Cell(1, 8).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(1, 8).Range.Text = "重量"
.Cell(1, 9).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(1, 9).Range.Text = "单价"
.Cell(1, 10).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(1, 10).Range.Text = "合计"
inum = 2
Dim ia As Integer
Do While Not rs.EOF
.Cell(inum, 1).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(inum, 1).Range.Text = inum - 1
.Cell(inum, 2).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(inum, 2).Range.Text = rs("DATENUM")
.Cell(inum, 3).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(inum, 3).Range.Text = sys.StrToText(rs("CARNUM"))
.Cell(inum, 4).Range.Paragraphs.Alignment = wdAlignParagraphCenter
For ia = 0 To UBound(arrstation, 2)
If arrstation(0, ia) = sys.TextTolong(rs("SENDSTATION")) Then
.Cell(inum, 4).Range.Text = arrstation(1, ia)
End If
Next
.Cell(inum, 5).Range.Paragraphs.Alignment = wdAlignParagraphCenter
For ia = 0 To UBound(arrstation, 2)
If arrstation(0, ia) = sys.TextTolong(rs("RECEIVESTATION")) Then
.Cell(inum, 5).Range.Text = arrstation(1, ia)
End If
Next
.Cell(inum, 6).Range.Paragraphs.Alignment = wdAlignParagraphCenter
For ia = 0 To UBound(arrclient, 2)
If arrclient(0, ia) = sys.TextTolong(rs("SENDER")) Then
.Cell(inum, 6).Range.Text = arrclient(1, ia)
End If
Next
.Cell(inum, 7).Range.Paragraphs.Alignment = wdAlignParagraphCenter
For ia = 0 To UBound(arrProduct, 2)
If arrProduct(0, ia) = sys.TextTolong(rs("PRODUCTNAME")) Then
.Cell(inum, 7).Range.Text = arrProduct(1, ia)
End If
Next
totalWeight = totalWeight + rs("WEIGHT")
.Cell(inum, 8).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(inum, 8).Range.Text = sys.StrToText(rs("WEIGHT"))
.Cell(inum, 9).Range.Paragraphs.Alignment = wdAlignParagraphCenter
If sys.TextTolong(rs("WEIGHT")) <> 0 Then
.Cell(inum, 9).Range.Text = FormatNumber(sys.TextToNum(rs("TOTAL") / rs("WEIGHT")), 2)
Else
.Cell(inum, 9).Range.Text = "-"
End If
totalMony = totalMony + rs("TOTAL")
.Cell(inum, 10).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(inum, 10).Range.Text = sys.StrToText(rs("TOTAL"))
rs.MoveNext
inum = inum + 1
Loop
End With
.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
If total <= 15 Then
.MoveDown Unit:=wdLine, Count:=16
Else
.MoveDown Unit:=wdLine, Count:=total + 1
End If
.ParagraphFormat.Alignment = wdAlignParagraphRight
.TypeText Text:="共计： " & total & " 车 (" & totalWeight & " 吨) 运费合计： " & totalMony & " 元"
.TypeParagraph
.TypeParagraph
.ParagraphFormat.Alignment = wdAlignParagraphRight
.TypeText Text:="宜春市金胜物流有限公司 "
.TypeParagraph
.TypeText Text:=sys.StrToText(Year(Date)) & " 年 " & sys.StrToText(Month(Date)) & " 月" & sys.StrToText(Day(Date)) & " 日"
End With
wordApp.PrintOut
Else
MsgBox "数据错误!"
Unload Me
End If
Else
MsgBox "请先选择要打印的记录!"
End If
End Sub
Private Sub cmdAllView_Click()
Dim ir As Integer
Dim strTtaffic As String
ir = 1
For ir = 1 To lsvTraffic.ListItems.Count
If IsNumeric(lsvTraffic.ListItems.Item(ir).Tag) Then
strTtaffic = strTtaffic & sys.TextTolong(lsvTraffic.ListItems.Item(ir).Tag) & ","
End If
Next
If strTtaffic <> "" Then
'取得数据
Dim inum As Integer
Dim isfind As Boolean
Dim strTemp As String
Dim rs As New ADODB.Recordset
strsql = "SELECT * FROM TRAFFIC WHERE ID in (" & Left(strTtaffic, Len(strTtaffic) - 1) & ")"
Set rs = sys.DB.OpenRecordSet(strsql)
If Not rs.EOF Then
Dim wordApp As New Word.Application
Dim mysel As Word.Selection
Dim oTable As Word.Table
wordApp.Documents.Add
wordApp.Visible = True
Set mysel = wordApp.Selection
With mysel
'设置页面
With .PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = CentimetersToPoints(3.17)
.BottomMargin = CentimetersToPoints(3.17)
.LeftMargin = CentimetersToPoints(2.54)
.RightMargin = CentimetersToPoints(2.54)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.5)
.FooterDistance = CentimetersToPoints(1.75)
.PageWidth = CentimetersToPoints(29.7)
.PageHeight = CentimetersToPoints(21)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -