📄 frm_intout.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "Mshflxgd.ocx"
Begin VB.Form frm_intout
BackColor = &H00FFC0C0&
Caption = "物品进出情况"
ClientHeight = 8595
ClientLeft = 60
ClientTop = 345
ClientWidth = 11880
Icon = "frm_intout.frx":0000
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 8595
ScaleWidth = 11880
WindowState = 2 'Maximized
Begin VB.Frame Frame1
BackColor = &H00FFC0C0&
Height = 735
Left = 120
TabIndex = 1
Top = 720
Width = 9615
Begin VB.CommandButton Command2
BackColor = &H00FFC0C0&
Caption = "查 询"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7200
TabIndex = 7
Top = 240
Width = 975
End
Begin VB.CommandButton Command1
Caption = "导 出"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 8400
TabIndex = 4
Top = 240
Width = 975
End
Begin VB.CheckBox Check1
BackColor = &H00FFC0C0&
Caption = "时段"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 2
Top = 240
Width = 975
End
Begin MSComctlLib.ProgressBar pb
Height = 375
Left = 5280
TabIndex = 3
Top = 240
Width = 1695
_ExtentX = 2990
_ExtentY = 661
_Version = 393216
Appearance = 0
Max = 8
Scrolling = 1
End
Begin MSComCtl2.DTPicker DTPicker2
Height = 375
Left = 3480
TabIndex = 5
Top = 240
Width = 1455
_ExtentX = 2566
_ExtentY = 661
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 23658497
CurrentDate = 38433
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 375
Left = 1320
TabIndex = 6
Top = 240
Width = 1455
_ExtentX = 2566
_ExtentY = 661
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 23658497
CurrentDate = 38433
End
Begin VB.Label Label1
BackColor = &H00FFC0C0&
Caption = "—>"
Height = 255
Left = 3000
TabIndex = 8
Top = 360
Width = 495
End
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid msglist
Height = 6495
Left = 45
TabIndex = 0
Top = 1500
Width = 9750
_ExtentX = 17198
_ExtentY = 11456
_Version = 393216
BackColor = 16761024
FixedCols = 0
BackColorFixed = 16744448
BackColorBkg = 16761024
FocusRect = 0
SelectionMode = 1
AllowUserResizing= 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_NumberOfBands = 1
_Band(0).Cols = 2
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H00FFC0C0&
Caption = "物品出入情况统计"
BeginProperty Font
Name = "Tahoma"
Size = 26.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000080&
Height = 735
Left = 2280
TabIndex = 9
Top = 0
Width = 4695
End
End
Attribute VB_Name = "frm_intout"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
Dim app As New Excel.Application
Dim book As New Excel.Workbook
Dim sheet As New Excel.Worksheet
Set book = app.Workbooks.Add
Set sheet = book.Worksheets.Add
app.Visible = False
pb.Appearance = cc3D
pb.Max = msglist.rows
pb.Min = 0
pb.Visible = True
sheet.Columns(1).ColumnWidth = 6
sheet.Columns(2).ColumnWidth = 25
sheet.Columns(3).ColumnWidth = 8
sheet.Columns(4).ColumnWidth = 8
sheet.Columns(5).ColumnWidth = 8
sheet.Columns(6).ColumnWidth = 5
sheet.Columns(7).ColumnWidth = 5
sheet.Columns(8).ColumnWidth = 5
sheet.Columns(9).ColumnWidth = 5
sheet.Columns(10).ColumnWidth = 7
sheet.Columns(11).ColumnWidth = 7
sheet.Columns(12).ColumnWidth = 7
sheet.Columns(13).ColumnWidth = 9
sheet.Columns(14).ColumnWidth = 7
sheet.Columns(15).ColumnWidth = 9
sheet.Columns(16).ColumnWidth = 7
sheet.Range("A1").Select: app.Selection.HorizontalAlignment = xlCenter
sheet.Range("B1").Select: app.Selection.HorizontalAlignment = xlCenter
sheet.Range("C1").Select: app.Selection.HorizontalAlignment = xlCenter
sheet.Range("D1").Select: app.Selection.HorizontalAlignment = xlCenter
sheet.Range("E1").Select: app.Selection.HorizontalAlignment = xlCenter
sheet.Range("F1").Select: app.Selection.HorizontalAlignment = xlCenter
sheet.Range("G1").Select: app.Selection.HorizontalAlignment = xlCenter
sheet.Range("H1").Select: app.Selection.HorizontalAlignment = xlCenter
sheet.Range("I1").Select: app.Selection.HorizontalAlignment = xlCenter
sheet.Range("J1").Select: app.Selection.HorizontalAlignment = xlCenter
Dim i As Long
With msglist
For i = 0 To .rows - 1
pb.Value = pb.Value + 1
sheet.cells(i + 1, 1) = .TextMatrix(i, 0)
sheet.cells(i + 1, 2) = .TextMatrix(i, 1)
sheet.cells(i + 1, 3) = .TextMatrix(i, 2)
sheet.cells(i + 1, 4) = .TextMatrix(i, 3)
sheet.cells(i + 1, 5) = .TextMatrix(i, 4)
sheet.cells(i + 1, 6) = .TextMatrix(i, 5)
sheet.cells(i + 1, 7) = .TextMatrix(i, 6)
sheet.cells(i + 1, 8) = .TextMatrix(i, 7)
sheet.cells(i + 1, 9) = .TextMatrix(i, 8)
sheet.cells(i + 1, 10) = .TextMatrix(i, 9)
sheet.cells(i + 1, 11) = .TextMatrix(i, 10)
sheet.cells(i + 1, 12) = .TextMatrix(i, 11)
sheet.cells(i + 1, 13) = .TextMatrix(i, 12)
sheet.cells(i + 1, 14) = .TextMatrix(i, 13)
sheet.cells(i + 1, 15) = .TextMatrix(i, 14)
sheet.cells(i + 1, 16) = .TextMatrix(i, 15)
Next
End With
pb.Value = 1
pb.Appearance = ccFlat
pb.Visible = False
app.Visible = True
Set app = Nothing
Set book = Nothing
Set sheet = Nothing
End Sub
Private Sub Command2_Click()
Dim mrc As New ADODB.Recordset
Dim i As Long
Dim TxtSQL As String
pb.Visible = True
pb.Max = 14
pb.Min = 0
pb.Value = 0
Check1.Enabled = False
TxtSQL = "select a.p_id,a.p_name,int(sum(a.qty)) from order_detail_b as a,ps_head_b as b"
TxtSQL = TxtSQL & " where b.ps_type='采购入库' "
If Check1.Value = 1 Then
TxtSQL = TxtSQL & " and a.order_id=b.ps_id and b.p_flag=no and b.ps_date>=#" & DTPicker1.Value & "# and b.ps_date<=#" & DTPicker2.Value & "#"
Else
TxtSQL = TxtSQL & " and a.order_id=b.ps_id and b.p_flag=no"
End If
TxtSQL = TxtSQL & " group by a.p_id,a.p_name "
TxtSQL = TxtSQL & " order by a.p_id"
mrc.Open TxtSQL, cnn, adOpenKeyset, adLockOptimistic
msglist.Clear
If Not mrc.EOF Then
pb.Appearance = cc3D
Set msglist.DataSource = mrc
Command1.Enabled = True
showtitle
msglist.row = 1
Else
Set mrc = Nothing
Command1.Enabled = False
msglist.Clear
showtitle
msglist.rows = 2
msglist.row = 1
pb.Visible = False
Check1.Enabled = True
Exit Sub
End If
If mrc.State = adStateOpen Then mrc.Close
pb.Value = pb.Value + 1
For i = 0 To msglist.rows - 1
msglist.row = i
msglist.col = 0
msglist.CellBackColor = &HFFFF80
msglist.col = 1
msglist.CellBackColor = &HFFFF80
msglist.col = 2
msglist.CellBackColor = &H8080FF
msglist.col = 3
msglist.CellBackColor = &H8080FF
msglist.col = 4
msglist.CellBackColor = &H8080FF
msglist.col = 5
msglist.CellBackColor = &H8080FF
msglist.col = 6
msglist.CellBackColor = &H8080FF
msglist.col = 7
msglist.CellBackColor = &HFF8080
msglist.col = 8
msglist.CellBackColor = &HFF8080
msglist.col = 9
msglist.CellBackColor = &HFF8080
msglist.col = 10
msglist.CellBackColor = &HFF8080
msglist.col = 12
msglist.CellBackColor = &HC000&
Next
TxtSQL = "select a.p_id,sum(a.qty) from order_detail_b as a,ps_head_b as b"
TxtSQL = TxtSQL & " where b.ps_type='盘盈入库'"
If Check1.Value = 1 Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -