module2.bas

这是一个医院管理系统中的院长查询模块

Attribute VB_Name = "Module2"
Sub BFRB(DATE1 As Date)
Dim d1 As Recordset
Dim dd As Excel.Application
Set d1 = db.OpenRecordset("SELECT * FROM BFRB WHERE RB_DATE >CDATE('" + CStr(DATE1) + "') AND RB_DATE<CDATE('" + CStr(DATE1 + 1) + "')")
If d1.EOF Then
d1.Close
MsgBox "请注意，今天无数据！", , "警告"
Exit Sub
End If
Set dd = CreateObject("Excel.Application")
dd.Workbooks.Open ("C:\PP\xls\BFRB")
dd.Range("A1").Select: dd.ActiveCell.FormulaR1C1 = "四平爱龄奇医院病房工作日报表"
dd.Range("A2").Select: dd.ActiveCell.FormulaR1C1 = " 报表日期：" + CStr(DATE1)
dd.Range("A18").Select: dd.ActiveCell.FormulaR1C1 = "医技科室及门诊诊疗人次日报表"
dd.Range("AM25").Select: dd.ActiveCell.FormulaR1C1 = "制 表：" + Form3.sbar.Panels(2) + " " + CStr(Date) + " " + CStr(Time)
dd.Visible = True
Do While Not d1.EOF
If d1!ks_id = "01" Then
dd.Range("E5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!BZC)
dd.Range("I5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XYC)
dd.Range("M5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!YRS)
dd.Range("Q5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS)
dd.Range("U5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS)
dd.Range("AC5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS)
dd.Range("AG5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS)
dd.Range("AK5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS)
dd.Range("AS5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS)
End If
If d1!ks_id = "02" Then
dd.Range("E6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!BZC)
dd.Range("I6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XYC)
dd.Range("M6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!YRS)
dd.Range("Q6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS)
dd.Range("U6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS)
dd.Range("AC6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS)
dd.Range("AG6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS)
dd.Range("AK6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS)
dd.Range("AS6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS)
End If
If d1!ks_id = "03" Then
dd.Range("E7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!BZC)
dd.Range("I7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XYC)
dd.Range("M7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!YRS)
dd.Range("Q7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS)
dd.Range("U7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS)
dd.Range("AC7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS)
dd.Range("AG7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS)
dd.Range("AK7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS)
dd.Range("AS7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS)
End If
If d1!ks_id = "04" Then
dd.Range("E8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!BZC)
dd.Range("I8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XYC)
dd.Range("M8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!YRS)
dd.Range("Q8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS)
dd.Range("U8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS)
dd.Range("AC8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS)
dd.Range("AG8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS)
dd.Range("AK8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS)
dd.Range("AS8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS)
End If
If d1!ks_id = "40" Then
dd.Range("E9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!BZC)
dd.Range("I9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XYC)
dd.Range("M9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!YRS)
dd.Range("Q9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS)
dd.Range("U9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS)
dd.Range("AC9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS)
dd.Range("AG9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS)
dd.Range("AK9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS)
dd.Range("AS9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS)
End If
If d1!ks_id = "05" Then
dd.Range("E10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!BZC)
dd.Range("I10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XYC)
dd.Range("M10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!YRS)
dd.Range("Q10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS)
dd.Range("U10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS)
dd.Range("AC10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS)
dd.Range("AG10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS)
dd.Range("AK10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS)
dd.Range("AS10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS)
End If
If d1!ks_id = "06" Then
dd.Range("E11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!BZC)
dd.Range("I11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XYC)
dd.Range("M11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!YRS)
dd.Range("Q11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS)
dd.Range("U11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS)
dd.Range("AC11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS)
dd.Range("AG11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS)
dd.Range("AK11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS)
dd.Range("AS11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS)
End If
If d1!ks_id = "07" Then
dd.Range("E12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!BZC)
dd.Range("I12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XYC)
dd.Range("M12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!YRS)
dd.Range("Q12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS)
dd.Range("U12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS)
dd.Range("AC12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS)
dd.Range("AG12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS)
dd.Range("AK12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS)
dd.Range("AS12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS)
End If
If d1!ks_id = "41" Then
dd.Range("E13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!BZC)
dd.Range("I13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XYC)
dd.Range("M13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!YRS)
dd.Range("Q13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS)
dd.Range("U13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS)
dd.Range("AC13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS)
dd.Range("AG13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS)
dd.Range("AK13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS)
dd.Range("AS13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS)
End If
If d1!ks_id = "08" Then
dd.Range("E14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!BZC)
dd.Range("I14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XYC)
dd.Range("M14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!YRS)
dd.Range("Q14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS)
dd.Range("U14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS)
dd.Range("AC14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS)
dd.Range("AG14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS)
dd.Range("AK14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS)
dd.Range("AS14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS)
End If
If d1!ks_id = "09" Then
dd.Range("E15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!BZC)
dd.Range("I15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XYC)
dd.Range("M15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!YRS)
dd.Range("Q15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS)
dd.Range("U15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS)
dd.Range("AC15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS)
dd.Range("AG15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS)
dd.Range("AK15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS)
dd.Range("AS15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS)
End If
d1.MoveNext
Loop
d1.Close
Set d1 = db.OpenRecordset("SELECT * FROM BFRB_TWO WHERE RB_DATE >=CDATE('" + CStr(DATE1) + "') AND RB_DATE<CDATE('" + CStr(DATE1 + 1) + "')")
If d1.EOF Then
d1.Close
GoTo DDSS
End If
dd.Range("E21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!DZ1)
dd.Range("H21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!DZ2)
dd.Range("K21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!FS1)
dd.Range("N21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!FS2)
dd.Range("Q21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JY1)
dd.Range("T21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JY2)
dd.Range("W21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JY3)
dd.Range("Z21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JY4)
dd.Range("AC21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!QJ1)
dd.Range("AF21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!QJ2)
dd.Range("AI21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CT1)
dd.Range("AL21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CT2)
dd.Range("AO21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JZ1)
dd.Range("AR21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JZ2)
dd.Range("AU21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JZ3)
dd.Range("AX21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!BL)
dd.Range("BA21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!LL)
dd.Range("A24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!N1)
dd.Range("D24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!N2)
dd.Range("G24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!N3)
dd.Range("J24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!N4)
dd.Range("M24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!N5)
dd.Range("P24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!W1)
dd.Range("S24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!W2)
dd.Range("V24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!W3)
dd.Range("Y24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!W4)
dd.Range("AB24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!WG)
dd.Range("AE24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!FC)
dd.Range("AH24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!PF)
dd.Range("AK24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZY)
dd.Range("AN24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!EK)
dd.Range("AQ24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SQ)
dd.Range("AT24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JZ)
dd.Range("AW24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!QT)
'dd.Range("BD21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ss)
d1.Close
DDSS:
dd.Visible = True
dd.ActiveWorkbook.PrintPreview
dd.ActiveWorkbook.Saved = True
dd.ActiveWorkbook.Close
dd.Quit
End Sub

Sub BFYB(DATE1 As Date, DATE2 As Date, nos As Integer)
Dim d1 As Recordset
Dim d2 As Recordset
Dim dd As Excel.Application
Set d1 = db.OpenRecordset("SELECT * FROM BFRB WHERE RB_DATE >CDATE('" + CStr(DATE1) + "') AND RB_DATE<CDATE('" + CStr(DATE2 + 1) + "')")
If d1.EOF Then
d1.Close
MsgBox "请注意，无数据统计！", , "警告"
Exit Sub
End If
d1.Close
ss = DATE2 - DATE1
Set d1 = db.OpenRecordset("SELECT KS_ID,sum(bzcsyl) as bzcsyl1,sum(cwsyl) as cwsyl1,SUM(SWS) AS SWS1,SUM(RYRS) AS RYRS1,SUM(ZRRS) AS ZRRS1,SUM(CYRS) AS CYRS1,SUM(ZCRS) AS ZCRS1 FROM BFRB WHERE RB_DATE >CDATE('" + CStr(DATE1) + "') AND RB_DATE<CDATE('" + CStr(DATE2 + 1) + "') GROUP BY KS_ID")
Set dd = CreateObject("Excel.Application")
If DATE2 - DATE1 < 10 Then
dd.Workbooks.Open ("C:\PP\xls\BFZB")
Else
dd.Workbooks.Open ("C:\PP\xls\BFyb")
End If
dd.Range("A1").Select: dd.ActiveCell.FormulaR1C1 = "四平爱龄奇医院病房工作统计表"
dd.Range("A2").Select: dd.ActiveCell.FormulaR1C1 = " 统计区间：" + CStr(DATE1) + " 至 " + CStr(DATE2)
dd.Range("A18").Select: dd.ActiveCell.FormulaR1C1 = "医技科室及门诊诊疗人次统计表"
dd.Range("AM25").Select: dd.ActiveCell.FormulaR1C1 = "制 表：" + Form3.sbar.Panels(2) + " " + CStr(Date) + " " + CStr(Time)
dd.Visible = True
Do While Not d1.EOF
Set d2 = db.OpenRecordset("SELECT TOP 1 * FROM BFRB WHERE RB_DATE >CDATE('" + CStr(DATE1) + "') AND RB_DATE<CDATE('" + CStr(DATE2 + 1) + "') AND KS_ID='" + d1!ks_id + "' ORDER BY RB_DATE")
YRS1 = DxCStr(d2!YRS)
d2.Close
Set d2 = db.OpenRecordset("SELECT TOP 1 * FROM BFRB WHERE RB_DATE >CDATE('" + CStr(DATE1) + "') AND RB_DATE<CDATE('" + CStr(DATE2 + 1) + "') AND KS_ID='" + d1!ks_id + "' ORDER BY RB_DATE DESC")
XRS1 = DxCStr(d2!XRS)
XYC1 = DxCStr(d2!XYC)
BZC1 = DxCStr(d2!BZC)
d2.Close
If d1!ks_id = "01" Then
dd.Range("E5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("I5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("M5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(YRS1)
dd.Range("Q5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS1)
dd.Range("U5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS1)
dd.Range("AC5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS1)
dd.Range("AG5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS1)
dd.Range("AK5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS1)
dd.Range("AS5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XRS1)
dd.Range("Ax5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!bzcsyl1 / (Val(ss) + 1))
dd.Range("bc5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!cwsyl1 / (Val(ss) + 1))
End If
If d1!ks_id = "02" Then
dd.Range("E6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("I6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("M6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(YRS1)
dd.Range("Q6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS1)
dd.Range("U6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS1)
dd.Range("AC6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS1)
dd.Range("AG6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS1)