📄 guestdata.frm
字号:
_ExtentX = 5741
_ExtentY = 4683
_Version = 393216
Style = 1
Tabs = 4
Tab = 3
TabsPerRow = 4
TabHeight = 520
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
TabCaption(0) = "Daily"
TabPicture(0) = "GuestData.frx":0EBC
Tab(0).ControlEnabled= 0 'False
Tab(0).Control(0)= "Frame5"
Tab(0).ControlCount= 1
TabCaption(1) = "Monthly"
TabPicture(1) = "GuestData.frx":0ED8
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "Frame6"
Tab(1).ControlCount= 1
TabCaption(2) = "Yearly"
TabPicture(2) = "GuestData.frx":0EF4
Tab(2).ControlEnabled= 0 'False
Tab(2).Control(0)= "Frame7"
Tab(2).ControlCount= 1
TabCaption(3) = "Periodic"
TabPicture(3) = "GuestData.frx":0F10
Tab(3).ControlEnabled= -1 'True
Tab(3).Control(0)= "Frame23"
Tab(3).Control(0).Enabled= 0 'False
Tab(3).Control(1)= "Command12"
Tab(3).Control(1).Enabled= 0 'False
Tab(3).Control(2)= "Frame24"
Tab(3).Control(2).Enabled= 0 'False
Tab(3).ControlCount= 3
Begin VB.Frame Frame24
Caption = "Enter End Date"
Height = 735
Left = 600
TabIndex = 64
Top = 1200
Width = 1935
Begin MSComCtl2.DTPicker DTPicker6
Height = 375
Left = 120
TabIndex = 65
Top = 240
Width = 1695
_ExtentX = 2990
_ExtentY = 661
_Version = 393216
Format = 19529729
CurrentDate = 38272
End
End
Begin VB.CommandButton Command12
BackColor = &H00FFC0C0&
Caption = "RUN >>"
Height = 375
Left = 840
Style = 1 'Graphical
TabIndex = 63
Top = 2040
Width = 1575
End
Begin VB.Frame Frame7
Caption = "Enter Year"
Height = 1455
Left = -74400
TabIndex = 7
Top = 720
Width = 2055
Begin VB.CommandButton Command1
BackColor = &H00FFC0C0&
Caption = "RUN >>"
Height = 375
Left = 240
Style = 1 'Graphical
TabIndex = 9
Top = 840
Width = 1575
End
Begin VB.TextBox Text1
Alignment = 2 'Center
Height = 375
Left = 360
TabIndex = 8
Top = 360
Width = 1335
End
End
Begin VB.Frame Frame6
Caption = "Enter Month and Year"
Height = 1695
Left = -74400
TabIndex = 3
Top = 600
Width = 2055
Begin VB.TextBox Text2
Alignment = 2 'Center
Height = 375
Left = 360
TabIndex = 6
Top = 720
Width = 1335
End
Begin VB.ComboBox Combo1
Height = 345
ItemData = "GuestData.frx":0F2C
Left = 360
List = "GuestData.frx":0F54
Style = 2 'Dropdown List
TabIndex = 5
Top = 360
Width = 1335
End
Begin VB.CommandButton Command3
BackColor = &H00FFC0C0&
Caption = "RUN >>"
Height = 375
Left = 240
Style = 1 'Graphical
TabIndex = 4
Top = 1140
Width = 1575
End
End
Begin VB.Frame Frame5
Caption = "Enter Date"
Height = 1455
Left = -74400
TabIndex = 2
Top = 600
Width = 2055
Begin VB.CommandButton Command2
BackColor = &H00FFC0C0&
Caption = "RUN >>"
Height = 375
Left = 240
Style = 1 'Graphical
TabIndex = 35
Top = 960
Width = 1575
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 390
Left = 240
TabIndex = 36
Top = 360
Width = 1575
_ExtentX = 2778
_ExtentY = 688
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
CalendarBackColor= 16777152
Format = 19529729
CurrentDate = 38257
End
End
Begin VB.Frame Frame23
Caption = "Enter Starting Date"
Height = 735
Left = 600
TabIndex = 61
Top = 480
Width = 1935
Begin MSComCtl2.DTPicker DTPicker5
Height = 375
Left = 120
TabIndex = 62
Top = 240
Width = 1695
_ExtentX = 2990
_ExtentY = 661
_Version = 393216
Format = 19529729
CurrentDate = 38272
End
End
End
End
End
Attribute VB_Name = "frmReports"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public int1 As Integer
Private Sub cmdMonthly_Click()
If cbomonth.Text = "" Or txtyear.Text = "" Then
MsgBox "Missing fields, please enter below.", vbCritical, "IIS-CVH"
Exit Sub
End If
GenerateMonthlyReport cbomonth.ListIndex + 1, CInt(txtyear.Text)
End Sub
Private Sub cmdWeekly_Click()
Dim finishdate As Date
finishdate = dtWeekly.Value + 6
GenerateWeeklyReport dtWeekly.Value, DTPicker4.Value
End Sub
Private Sub cmdYearly_Click()
If txtYR.Text = "" Then
MsgBox "Missing fields, please enter below.", vbCritical, "IIS-CVH"
Exit Sub
End If
GenerateYearlyReport CInt(txtYR.Text)
End Sub
Private Sub cmdDaily_Click()
GenerateDailyReport CDate(dtDaily.Value)
End Sub
Private Sub Command1_Click()
If Text1.Text = "" Then
MsgBox "Missing fields, please enter below.", vbCritical, "IIS-CVH"
Exit Sub
End If
GenerateRestaurantYearly CInt(Text1.Text)
End Sub
Public Sub GenerateRestaurantYearly(TheYear As Integer)
check_RS
' Set rs = New ADODB.Recordset
rs.Open "exec RestaurantYearly " & TheYear, Cnn ', adOpenDynamic, adLockOptimistic
With rptRestaurantYearly
Set .DataSource = rs
With .Sections("Section4").Controls
For i = 1 To .Count
If TypeOf .Item(i) Is RptLabel Then
'If .Item(i).Name = "lblmonth" Then
' .Item(i).Caption = (themonth)
If .Item(i).Name = "lblyear" Then
.Item(i).Caption = TheYear
End If
End If
Next i
End With
' Unload frmMonthEntry
.Refresh
.Show vbModal
End With
rs.Close
End Sub
Private Sub Command10_Click()
GenerateBarDaily CDate(DTPicker2.Value)
End Sub
Public Sub GenerateBarDaily(thedate As Date)
check_RS
rs.Open "exec BarDaily #" & thedate & "#", Cnn ', adOpenDynamic, adLockOptimistic
With rptBarDaily
Set .DataSource = rs
With .Sections("Section4").Controls
For i = 1 To .Count
If TypeOf .Item(i) Is RptLabel Then
If .Item(i).Name = "lblDate" Then
.Item(i).Caption = thedate
End If
End If
Next i
End With
.Refresh
'Unload frmReports
.Show vbModal
End With
rs.Close
End Sub
Private Sub Command11_Click()
GeneratePoolDaily CDate(DTPicker3.Value)
End Sub
Public Sub GeneratePoolDaily(thedate As Date)
check_RS
rs.Open "exec PoolDaily #" & thedate & "#", Cnn ', adOpenDynamic, adLockOptimistic
With rptPoolDaily
Set .DataSource = rs
With .Sections("Section4").Controls
For i = 1 To .Count
If TypeOf .Item(i) Is RptLabel Then
If .Item(i).Name = "lblDate" Then
.Item(i).Caption = thedate
End If
End If
Next i
End With
.Refresh
'Unload frmReports
.Show vbModal
End With
rs.Close
End Sub
Public Sub GenerateRestPeriodic(startDate As Date, finishdate As Date)
check_RS
rs.Open "exec restPer #" & startDate & "#,#" & finishdate & "#", Cnn ', adOpenDynamic, adLockOptimistic
With rptRestPer
Set .DataSource = rs
With .Sections("Section4").Controls
For i = 1 To .Count
If TypeOf .Item(i) Is RptLabel Then
If .Item(i).Name = "lblStart" Then
.Item(i).Caption = startDate
ElseIf .Item(i).Name = "lblFinish" Then
.Item(i).Caption = finishdate
End If
End If
Next i
End With
.Refresh
' Unload frmWeekEntry
.Show vbModal
End With
'r
rs.Close
End Sub
Private Sub Command12_Click()
GenerateRestPeriodic DTPicker5.Value, DTPicker6.Value
End Sub
Private Sub Command13_Click()
GenerateBarPeriodic DTPicker7.Value, DTPicker8.Value
End Sub
Public Sub GenerateBarPeriodic(startDate As Date, finishdate As Date)
check_RS
rs.Open "exec barPeriodic #" & startDate & "#,#" & finishdate & "#", Cnn ', adOpenDynamic, adLockOptimistic
With rptBarPer
Set .DataSource = rs
With .Sections("Section4").Controls
For i = 1 To .Count
If TypeOf .Item(i) Is RptLabel Then
If .Item(i).Name = "lblStart" Then
.Item(i).Caption = startDate
ElseIf .Item(i).Name = "lblFinish" Then
.Item(i).Caption = finishdate
End If
End If
Next i
End With
.Refresh
' Unload frmWeekEntry
.Show vbModal
End With
'r
rs.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -