selldatastat.frm
来自「一个关于电脑管理汽车的软件」· FRM 代码 · 共 446 行
FRM
446 行
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomctl.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{40D97E01-4259-4398-B597-183C348B488F}#1.0#0"; "BSE.ocx"
Begin VB.Form SellDataStat
BorderStyle = 1 'Fixed Single
Caption = "销售数据统计"
ClientHeight = 5355
ClientLeft = 45
ClientTop = 435
ClientWidth = 6315
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5355
ScaleWidth = 6315
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command1
Caption = "开 始"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1560
TabIndex = 7
Top = 4680
Width = 1095
End
Begin VB.CommandButton Command2
Caption = "放 弃"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3480
TabIndex = 8
Top = 4680
Width = 1095
End
Begin VB.CommandButton Command3
Caption = "完 成"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2520
TabIndex = 9
Top = 4680
Width = 1095
End
Begin VB.Frame frameInfo
Height = 855
Left = 0
TabIndex = 0
Top = 0
Width = 6375
Begin MSComCtl2.DTPicker DTPicker1
Height = 375
Index = 0
Left = 1680
TabIndex = 2
Top = 240
Width = 1695
_ExtentX = 2990
_ExtentY = 661
_Version = 393216
Format = 20054017
CurrentDate = 38310
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 375
Index = 1
Left = 3960
TabIndex = 3
Top = 240
Width = 1695
_ExtentX = 2990
_ExtentY = 661
_Version = 393216
Format = 20054017
CurrentDate = 38310
End
Begin VB.Label Label2
Caption = "到"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 1
Left = 3600
TabIndex = 5
Top = 360
Width = 375
End
Begin VB.Label Label2
Caption = "自"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 1320
TabIndex = 4
Top = 360
Width = 375
End
Begin VB.Label Label10
Caption = "统计时段:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 1
Top = 360
Width = 1335
End
End
Begin BSE_Engine.BSE BSE1
Left = 480
Top = 4800
_ExtentX = 6588
_ExtentY = 1085
End
Begin MSComctlLib.ListView lstBillDocu
Height = 3735
Left = 0
TabIndex = 6
Top = 840
Width = 6255
_ExtentX = 11033
_ExtentY = 6588
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = 8388608
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 4
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Name"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "Address"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "City, State, Zip"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "Notes"
Object.Width = 2540
EndProperty
End
End
Attribute VB_Name = "SellDataStat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
DealSellHistory
DealMaintain
VarInitData.lstSort lstBillDocu
Command1.Visible = False
Command2.Visible = False
Command3.Visible = True
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim i As Integer
VarInitData.InitBSE BSE1, 0
InitListView
For i = 0 To 1
DTPicker1(i).Value = Date
Next i
Command3.Visible = False
End Sub
Private Sub InitListView()
lstBillDocu.ColumnHeaders.Clear
With lstBillDocu.ColumnHeaders
.Add , , "销售日期"
.Add , , "销售额"
.Add , , "成本额"
.Add , , "单数"
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
If BSE1.EngineStarted Then BSE1.EndSubClassing
End Sub
Private Sub DealSellHistory()
Dim Filters As String
Dim TempSQL As String
Dim TempRS As MYSQL_RS, TempStr As String
Dim TempRS2 As MYSQL_RS
Dim VarFind As Variant, i As Long, K As Long
Dim TempDate() As Variant
Dim j As Long, TempIndex As Long, BillCount As Long
Dim TempMoney As Double, TempMoney2 As Double, TempMoney3 As Double
Dim BackGoodsBS As Boolean
'Filter by name
Filters = "Where selldate >= " & Quote(DTPicker1(0).Value) & " and selldate <= " & Quote(DTPicker1(1).Value)
TempSQL = VarInitData.DisplaySQLVal(19) & Filters
Set TempRS = New MYSQL_RS
TempRS.OpenRs TempSQL, gCnn
With TempRS
If .RecordCount > 0 Then
ReDim TempDate(1 To .RecordCount)
End If
i = 0
Do Until .EOF
If VarFunction.FindSameVariant(.Fields("selldate"), TempDate, .RecordCount) = False Then
i = i + 1
TempDate(i) = .Fields("selldate")
End If
.MoveNext
Loop
.CloseRecordset
.ReleaseMemory
End With
Set TempRS = Nothing
If i > 0 Then
K = 0
For j = 1 To i
K = 0
TempMoney = 0
TempMoney3 = 0
TempSQL = VarInitData.DisplaySQLVal(19) & " Where selldate = " & Quote(TempDate(j))
Set TempRS = New MYSQL_RS
TempRS.OpenRs TempSQL, gCnn
lstBillDocu.ListItems.Add
TempIndex = lstBillDocu.ListItems.Count
With TempRS
lstBillDocu.ListItems(TempIndex).Text = .Fields("selldate")
Do Until .EOF
K = K + 1
BackGoodsBS = False
TempMoney2 = .Fields("grealsellmoney")
If Mid(.Fields("billnum"), 2, 1) = "T" Then BackGoodsBS = True
If BackGoodsBS = True Then
TempMoney2 = -TempMoney2
End If
TempMoney = TempMoney + TempMoney2
TempSQL = "Select * From sellhistory2 " & " Where billnum = " & Quote(.Fields("billnum"))
Set TempRS2 = New MYSQL_RS
TempRS2.OpenRs TempSQL, gCnn
With TempRS2
Do Until .EOF
If BackGoodsBS = False Then
TempMoney3 = TempMoney3 + Val(.Fields("goodspricemoney"))
Else
TempMoney3 = TempMoney3 - Val(.Fields("goodspricemoney"))
End If
.MoveNext
Loop
.CloseRecordset
.ReleaseMemory
End With
Set TempRS2 = Nothing
.MoveNext
Loop
.CloseRecordset
.ReleaseMemory
End With
Set TempRS = Nothing
With lstBillDocu.ListItems(TempIndex)
.SubItems(1) = Format(TempMoney, VarInitData.MoneyFormat)
.SubItems(2) = Format(TempMoney3, VarInitData.MoneyFormat)
.SubItems(3) = K
End With
Next j
End If
End Sub
Private Sub DealMaintain()
Dim Filters As String
Dim TempSQL As String
Dim TempRS As MYSQL_RS, TempStr As String
Dim TempRS2 As MYSQL_RS
Dim VarFind As Variant, i As Long, K As Long, l As Long, TempCount As Long
Dim TempDate() As Variant, TempDate2() As Variant, CurrentDate As Variant
Dim j As Long, TempIndex As Long, BillCount As Long
Dim TempMoney As Double, TempMoney2 As Double, TempMoney3 As Double
Dim BackGoodsBS As Boolean
Dim MyItems As ListItems
'Filter by name
Filters = "Where drawdate >= " & Quote(DTPicker1(0).Value) & " and drawdate <= " & Quote(DTPicker1(1).Value)
TempSQL = VarInitData.DisplaySQLVal(38) & Filters
Set TempRS = New MYSQL_RS
TempRS.OpenRs TempSQL, gCnn
With TempRS
If .RecordCount > 0 Then
ReDim TempDate(1 To .RecordCount)
End If
i = 0
Do Until .EOF
If VarFunction.FindSameVariant(.Fields("drawdate"), TempDate, .RecordCount) = False Then
i = i + 1
TempDate(i) = .Fields("drawdate")
End If
.MoveNext
Loop
.CloseRecordset
.ReleaseMemory
End With
Set TempRS = Nothing
If i > 0 Then
K = 0
TempCount = lstBillDocu.ListItems.Count
If TempCount > 0 Then
Set MyItems = lstBillDocu.ListItems
ReDim TempDate2(1 To TempCount)
For l = 1 To TempCount
TempDate2(l) = MyItems(l).Text
Next l
End If
For j = 1 To i
K = 0
TempMoney = 0
TempMoney3 = 0
TempSQL = VarInitData.DisplaySQLVal(38) & " Where drawdate = " & Quote(TempDate(j))
Set TempRS = New MYSQL_RS
TempRS.OpenRs TempSQL, gCnn
With TempRS
CurrentDate = .Fields("drawdate")
Do Until .EOF
K = K + 1
BackGoodsBS = False
TempMoney2 = .Fields("gmoney")
TempMoney = TempMoney + TempMoney2
TempSQL = "Select * From maintainpartbill2 " & " Where drawbillnum = " & Quote(.Fields("drawbillnum"))
Set TempRS2 = New MYSQL_RS
TempRS2.OpenRs TempSQL, gCnn
With TempRS2
Do Until .EOF
TempMoney3 = TempMoney3 + Val(.Fields("goodspricemoney"))
.MoveNext
Loop
.CloseRecordset
.ReleaseMemory
End With
Set TempRS2 = Nothing
.MoveNext
Loop
.CloseRecordset
.ReleaseMemory
End With
Set TempRS = Nothing
If VarFunction.FindSameVariant(CurrentDate, TempDate2, TempCount, TempIndex) Then
With lstBillDocu.ListItems(TempIndex)
.SubItems(1) = Format(TempMoney + Val(.SubItems(1)), VarInitData.MoneyFormat)
.SubItems(2) = Format(TempMoney3 + Val(.SubItems(2)), VarInitData.MoneyFormat)
.SubItems(3) = K + Val(.SubItems(3))
End With
Else
lstBillDocu.ListItems.Add
TempIndex = lstBillDocu.ListItems.Count
With lstBillDocu.ListItems(TempIndex)
.Text = CurrentDate
.SubItems(1) = Format(TempMoney, VarInitData.MoneyFormat)
.SubItems(2) = Format(TempMoney3, VarInitData.MoneyFormat)
.SubItems(3) = K
End With
End If
Next j
End If
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?