📄 zdrctj.frm
字号:
Caption = "文件(&F)"
Begin VB.Menu MNU11
Caption = "打印设置"
End
Begin VB.Menu MNU12
Caption = "打印预览"
Enabled = 0 'False
End
Begin VB.Menu MNU13
Caption = "打印 "
Enabled = 0 'False
Shortcut = ^P
End
Begin VB.Menu MNU15
Caption = "-"
End
Begin VB.Menu MNU16
Caption = "退出(&E)"
End
End
Begin VB.Menu MNU3
Caption = "查看(&V)"
Begin VB.Menu MNU3_1
Caption = "统计表"
End
Begin VB.Menu MNU3_2
Caption = "统计图"
End
End
Begin VB.Menu MNU4
Caption = "计算器(&J)"
End
Begin VB.Menu MNU5
Caption = "帮助(&H)"
Begin VB.Menu MNU51
Caption = "帮助主题"
Shortcut = {F1}
End
Begin VB.Menu MNU52
Caption = "索引"
Enabled = 0 'False
End
Begin VB.Menu MNU53
Caption = "-"
End
Begin VB.Menu MNU54
Caption = "关于红日软件..."
End
End
End
Attribute VB_Name = "ZDRCTJ"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DATJDGL As Database
Dim RECZDRC As Recordset
Private Sub Form_Load()
Dim INTROW As Integer
Data1.DatabaseName = App.Path & "\data\jdgl.mdb"
Data1.Refresh
Set DATJDGL = OpenDatabase(App.Path & "\DATA\JDGL.MDB")
Set RECZDRC = DATJDGL.OpenRecordset("住房人次统计", dbOpenDynaset)
With MSChart1
.TitleText = CStr(Year(Now)) + "年" + .TitleText
For INTROW = 1 To 12
.Row = INTROW
.RowLabel = CStr(INTROW) + "月"
.Data = INTROW + 1
Next
End With
End Sub
Private Sub MNU11_Click()
CDLTEST.flags = cdlPDDisablePrintToFile
CDLTEST.Copies = 3
CDLTEST.PrinterDefault = True
CDLTEST.ShowPrinter
End Sub
Private Sub MNU16_Click()
Unload Me
End Sub
Private Sub MNU3_2_Click()
DBGrid1.Visible = False
MSChart1.Visible = True
Frame1.Visible = True
End Sub
Private Sub MNU3_1_Click()
DBGrid1.Visible = True
Frame1.Visible = False
MSChart1.Visible = False
End Sub
Private Sub MNU4_Click()
Dim jsq As Double
jsq = Shell("calc", vbNormalNoFocus)
End Sub
Private Sub MNU51_Click()
Shell App.Path & "\hh.exe " & App.Path & "\help.chm", vbNormalFocus
End Sub
Private Sub MNU54_Click()
Load frmAbout
frmAbout.Show vbModal
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
Load JBBWIN1
JBBWIN1.Label1.Caption = "请稍候!正在统计全年住房人次..."
JBBWIN1.Show
Timer3.Enabled = True
End Sub
Private Sub Timer2_Timer()
Timer1.Enabled = True
Timer2.Enabled = False
End Sub
Private Sub Timer3_Timer()
Dim OBJFIELD As Field
Dim DAYS As Integer
Dim INTRC As Integer
Dim RECSK1 As Recordset
Dim RECSK2 As Recordset
Dim RECTH1 As Recordset
Dim RECTH2 As Recordset
Dim RECYTJ As Recordset
Timer3.Enabled = False
With RECZDRC
For Each OBJFIELD In .Fields
If Not OBJFIELD.Name = "ID" And Not OBJFIELD.Name = "DAY" And Not OBJFIELD.Name = "SF" Then
If OBJFIELD.Name = 2 Then
If Year(Now) Mod 4 <> 0 Then
DAYS = 28
Else
DAYS = 29
End If
Else
If OBJFIELD.Name <= 7 Then
If OBJFIELD.Name Mod 2 = 0 Then
DAYS = 30
Else
DAYS = 31
End If
Else
If OBJFIELD.Name Mod 2 = 0 Then
DAYS = 31
Else
DAYS = 30
End If
End If
End If
While Not RECZDRC.EOF
INTRC = 0
TJDATE = CDate(CStr(Year(Now)) + "年" + OBJFIELD.Name + "月" + CStr(RECZDRC("DAY")) + "日")
If TJDATE <= Now() Then
Set RECSK1 = DATJDGL.OpenRecordset("SELECT 散客登记表.ID, 散客登记表.入住日期, 散客登记表.离住日期, 散客登记表.住房 From 散客登记表 WHERE (((散客登记表.入住日期)<=#" & TJDATE & "#) AND ((散客登记表.住房)=True))")
If RECSK1.RecordCount > 0 Then RECSK1.MoveLast
Set RECSK2 = DATJDGL.OpenRecordset("SELECT 散客结帐.ID, 散客结帐.入住日期, 散客结帐.离住日期, 散客结帐.住房 From 散客结帐 WHERE (((散客结帐.入住日期)<=#" & TJDATE & "#) AND ((散客结帐.离住日期)>#" & TJDATE & "#) AND ((散客结帐.住房)=True))")
If RECSK2.RecordCount > 0 Then RECSK2.MoveLast
Set RECTH1 = DATJDGL.OpenRecordset("SELECT DISTINCTROW 团会登记表.入住日期, 团会登记表.住房, Sum(团会登记表.团体人数) AS 团体人数, Sum(团会登记表.陪同人数) AS 陪同人数 From 团会登记表 GROUP BY 团会登记表.入住日期, 团会登记表.住房 HAVING (((团会登记表.入住日期)<=#" & TJDATE & "#) AND ((团会登记表.住房)=True))")
Set RECTH2 = DATJDGL.OpenRecordset("SELECT DISTINCTROW 团会结帐.入住日期, 团会结帐.离住日期, 团会结帐.住房, Sum(团会结帐.团体人数) AS 团体人数, Sum(团会结帐.陪同人数) AS 陪同人数 From 团会结帐 GROUP BY 团会结帐.入住日期, 团会结帐.离住日期, 团会结帐.住房 HAVING (((团会结帐.入住日期)<=#" & TJDATE & "#) AND ((团会结帐.离住日期)>#" & TJDATE & "#) AND ((团会结帐.住房)=True))")
INTRC = RECSK1.RecordCount + RECSK2.RecordCount
While Not RECTH1.EOF
INTRC = INTRC + IIf(RECTH1("团体人数") <> 0, RECTH1("团体人数"), 0) + IIf(RECTH1("陪同人数") <> 0, RECTH1("陪同人数"), 0)
RECTH1.MoveNext
Wend
While Not RECTH2.EOF
INTRC = INTRC + IIf(RECTH2("团体人数") <> 0, RECTH2("团体人数"), 0) + IIf(RECTH2("陪同人数") <> 0, RECTH2("陪同人数"), 0)
RECTH2.MoveNext
Wend
MYMARK = RECZDRC.Bookmark
RECZDRC.Edit
RECZDRC(OBJFIELD.Name) = INTRC
RECZDRC.Update
RECZDRC.Bookmark = MYMARK
Else
MYMARK = RECZDRC.Bookmark
RECZDRC.Edit
RECZDRC(OBJFIELD.Name) = 0
RECZDRC.Update
RECZDRC.Bookmark = MYMARK
End If
RECZDRC.MoveNext
If Not RECZDRC.EOF Then
If RECZDRC("DAY") > DAYS Then GoTo FIELDNEXT
End If
Wend
FIELDNEXT:
JBBWIN1.ProgressBar1.Value = JBBWIN1.ProgressBar1.Max / 12 * CInt(OBJFIELD.Name)
RECZDRC.MoveFirst
End If
Next
End With
Set RECYTJ = DATJDGL.OpenRecordset("SELECT DISTINCTROW 住房人次统计.SF, Sum(住房人次统计.[1]) AS 1, Sum(住房人次统计.[2]) AS 2, Sum(住房人次统计.[3]) AS 3, Sum(住房人次统计.[4]) AS 4, Sum(住房人次统计.[5]) AS 5, Sum(住房人次统计.[6]) AS 6, Sum(住房人次统计.[7]) AS 7, Sum(住房人次统计.[8]) AS 8, Sum(住房人次统计.[9]) AS 9, Sum(住房人次统计.[10]) AS 10, Sum(住房人次统计.[11]) AS 11, Sum(住房人次统计.[12]) AS 12 From 住房人次统计 GROUP BY 住房人次统计.SF")
Frame1.Visible = True
With MSChart1
For INTROW = 1 To 12
.Row = INTROW
.Data = RECYTJ(CStr(INTROW))
If .Data <> 0 Then
Label1(INTROW - 1).Caption = CStr(.Data)
Else
Label1(INTROW - 1).Caption = ""
End If
Next
End With
Data1.Recordset.Requery
Data1.Refresh
Unload JBBWIN1
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -