📄 上报数据.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form 上报数据
BorderStyle = 1 'Fixed Single
Caption = "日期范围选择"
ClientHeight = 4035
ClientLeft = 2475
ClientTop = 2565
ClientWidth = 7110
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Moveable = 0 'False
ScaleHeight = 4035
ScaleWidth = 7110
Begin VB.TextBox Text1
DataField = "ID"
DataSource = "Data1"
Height = 270
Index = 0
Left = 240
TabIndex = 14
Text = "Text1"
Top = 2580
Visible = 0 'False
Width = 885
End
Begin VB.TextBox Text1
DataField = "发车日期"
DataSource = "Data1"
Height = 270
Index = 1
Left = 1200
TabIndex = 13
Text = "Text1"
Top = 2580
Visible = 0 'False
Width = 855
End
Begin VB.TextBox Text4
DataField = "班组"
DataSource = "Data2"
Height = 285
Index = 3
Left = 2490
TabIndex = 12
Text = "Text4"
Top = 4140
Width = 1005
End
Begin VB.TextBox Text4
DataField = "车次"
DataSource = "Data2"
Height = 285
Index = 2
Left = 1410
TabIndex = 11
Text = "Text4"
Top = 4170
Width = 1005
End
Begin VB.TextBox Text4
DataField = "发车日期"
DataSource = "Data2"
Height = 285
Index = 1
Left = 570
TabIndex = 10
Text = "Text4"
Top = 4200
Width = 1005
End
Begin VB.TextBox Text1
DataField = "班组"
DataSource = "Data1"
Height = 270
Index = 3
Left = 2850
TabIndex = 9
Text = "Text1"
Top = 2640
Visible = 0 'False
Width = 735
End
Begin VB.TextBox Text1
DataField = "车次"
DataSource = "Data1"
Height = 270
Index = 2
Left = 2100
TabIndex = 8
Text = "Text1"
Top = 2610
Visible = 0 'False
Width = 735
End
Begin VB.Data Data5
Caption = "Data5"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 405
Left = 3270
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 5580
Width = 2115
End
Begin VB.Data Data4
Caption = "Data4"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 375
Left = 1140
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 5460
Width = 1605
End
Begin VB.Data Data3
Caption = "Data3"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 495
Left = 4170
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 4830
Width = 2085
End
Begin VB.Data Data2
Caption = "Data2"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 435
Left = 1080
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "日期车次"
Top = 4770
Width = 1875
End
Begin VB.TextBox Text3
Alignment = 2 'Center
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 465
Left = 4650
TabIndex = 7
Top = 1680
Width = 2145
End
Begin VB.CommandButton Command2
Caption = "取 消"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4140
TabIndex = 4
Top = 2490
Width = 1305
End
Begin VB.TextBox Text2
Alignment = 2 'Center
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00008000&
Height = 405
Left = 4650
TabIndex = 3
Top = 570
Width = 2115
End
Begin MSComCtl2.MonthView MonthView1
Height = 2220
Left = 300
TabIndex = 2
Top = 120
Width = 4065
_ExtentX = 7170
_ExtentY = 3916
_Version = 393216
ForeColor = 0
BackColor = 8421631
Appearance = 1
MonthBackColor = 16777215
StartOfWeek = 166461441
TitleBackColor = 16711680
TitleForeColor = -2147483634
TrailingForeColor= 32768
CurrentDate = 37357
End
Begin VB.CommandButton Command1
Caption = "确 认"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5520
TabIndex = 1
Top = 2490
Width = 1305
End
Begin VB.ComboBox Combo1
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1410
TabIndex = 0
Top = 1080
Width = 1905
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 840
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "日期车次"
Top = 3060
Width = 2595
End
Begin VB.Label Label2
Caption = "截止日期："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4650
TabIndex = 6
Top = 1200
Width = 1305
End
Begin VB.Label Label1
Caption = "起始日期："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4650
TabIndex = 5
Top = 210
Width = 1575
End
End
Attribute VB_Name = "上报数据"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim X() As String, DateData1 As String, DateData2 As String
Dim Cxtj As String, Cxs As String, StatData As String, EndData As String
Dim Flag As Integer, DateA() As String, CcData() As String, BzData() As String
Dim Num As Integer, StatrNum As Integer, EndNum As Integer, I As Integer
Private Sub Command1_Click()
Dim Result As Integer
On Error GoTo A1
Cxs = "[" + Cxtj + "]" + "=" + "'" + Text2 + "'"
Data1.RecordSource = "Select * from 日期车次 where" & Cxs
Data1.Refresh
StatrNum = Text1(0)
Cxs = "[" + Cxtj + "]" + "=" + "'" + Text3 + "'"
Data1.RecordSource = "Select * from 日期车次 where" & Cxs
Data1.Refresh
EndNum = Text1(0)
Num = EndNum - StatrNum + 1
ReDim DateA(Num) As String, CcData(Num) As String, BzData(Num) As String
Data1.Recordset.Close
If Text2 <> Text3 Then
Result = MsgBox(" 现在准备上报从 " + Text2 + " 到 " + Text3 + " 的记录，点击确定这个日期范围内的数据将作为上报数据 ！ ", vbExclamation + vbOKCancel, "提示信息")
Else
Result = MsgBox(" 现在准备上报 " + Text2 + " 的记录，点击确定这个日期的数据将作为上报数据 ！ ", vbExclamation + vbOKCancel, "提示信息")
End If
If Result = 1 Then
Data2.Refresh
Data2.Recordset.Move StatrNum - 1
For I = 1 To Num
DateA(I) = Text4(1): CcData(I) = Text4(2): BzData(I) = Text4(3)
Data2.Recordset.MoveNext
Next I
Data2.Recordset.Close
For I = 1 To Num
Debug.Print DateA(I), CcData(I), BzData(I)
Next I
MsgBox " 正在上报记录，请等待 ！ ", vbExclamation, "提示信息"
Else
Command1.Enabled = False
Command2.SetFocus
Exit Sub
End If
' 工作选项.Enabled = True
' 工作选项.Show
Unload Me
Exit Sub
' End If
A1:
' 工作选项.Enabled = True
' 工作选项.Show
Unload Me
End Sub
Private Sub Command2_Click()
工作选项.Enabled = True
Unload Me
End Sub
Private Sub Form_Load()
Dim Num As Integer, I As Integer
Data1.DatabaseName = App.Path + "\" + "原始记录.mdb"
Data2.DatabaseName = App.Path + "\" + "原始记录.mdb"
Data3.DatabaseName = App.Path + "\" + "班组统计.mdb"
Data4.DatabaseName = App.Path + "\" + "原始记录.mdb"
Data5.DatabaseName = App.Path + "\" + "原始记录.mdb"
Data1.Refresh
MonthView1.Value = Date
Num = 0
End Sub
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
DateData1 = Format(MonthView1.Value, "yyyy年m月d日")
If Flag = 0 Then
Text2 = DateData1
StatData = Text2
Cxtj = "发车日期"
Cxs = "[" + Cxtj + "]" + "=" + "'" + Text2 + "'"
Data1.RecordSource = "Select * from 日期车次 where" & Cxs
Data1.Refresh
If Text1(1) = "" Then
MsgBox " 没有 " + Text2 + " 为起始日期的记录，请重作日期选择 ！ ", vbExclamation, "提示信息"
Command1.Enabled = False
Command2.SetFocus
Text2 = ""
Exit Sub
End If
Flag = 1
Else
Text3 = DateData1
EndData = Text3
Cxs = "[" + Cxtj + "]" + "=" + "'" + Text3 + "'"
Data1.RecordSource = "Select * from 日期车次 where" & Cxs
Data1.Refresh
If Text1(1) = "" Then
MsgBox " 没有 " + Text3 + " 为截止日期的记录，请重作日期选择 ！ ", vbExclamation, "提示信息"
Text3 = ""
Command1.Enabled = False
Command2.SetFocus
Exit Sub
End If
Flag = 0
If CDate(StatData) > CDate(EndData) Then
MsgBox " 截止日期不能早于起始日期，请重作日期选择 ！ ", vbExclamation, "提示信息"
Text2 = "": Text3 = ""
Command1.Enabled = False
Command2.SetFocus
Exit Sub
Else
Command1.Enabled = True
Command1.SetFocus
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -