module2.bas

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

dd.Range("AK6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS1)
dd.Range("AS6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XRS1)
dd.Range("Ax6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!bzcsyl1 / (Val(ss) + 1))
dd.Range("bc6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!cwsyl1 / (Val(ss) + 1))
End If
If d1!ks_id = "03" Then
dd.Range("E7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("I7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("M7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(YRS1)
dd.Range("Q7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS1)
dd.Range("U7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS1)
dd.Range("AC7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS1)
dd.Range("AG7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS1)
dd.Range("AK7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS1)
dd.Range("AS7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XRS1)
dd.Range("Ax7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!bzcsyl1 / (Val(ss) + 1))
dd.Range("bc7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!cwsyl1 / (Val(ss) + 1))
End If
If d1!ks_id = "04" Then
dd.Range("E8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("I8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("M8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(YRS1)
dd.Range("Q8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS1)
dd.Range("U8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS1)
dd.Range("AC8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS1)
dd.Range("AG8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS1)
dd.Range("AK8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS1)
dd.Range("AS8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XRS1)
dd.Range("Ax8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!bzcsyl1 / (Val(ss) + 1))
dd.Range("bc8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!cwsyl1 / (Val(ss) + 1))
End If
If d1!ks_id = "40" Then
dd.Range("E9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("I9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("M9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(YRS1)
dd.Range("Q9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS1)
dd.Range("U9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS1)
dd.Range("AC9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS1)
dd.Range("AG9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS1)
dd.Range("AK9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS1)
dd.Range("AS9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XRS1)
dd.Range("Ax9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!bzcsyl1 / (Val(ss) + 1))
dd.Range("bc9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!cwsyl1 / (Val(ss) + 1))
End If
If d1!ks_id = "05" Then
dd.Range("E10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("I10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("M10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(YRS1)
dd.Range("Q10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS1)
dd.Range("U10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS1)
dd.Range("AC10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS1)
dd.Range("AG10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS1)
dd.Range("AK10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS1)
dd.Range("AS10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XRS1)
dd.Range("Ax10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!bzcsyl1 / (Val(ss) + 1))
dd.Range("bc10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!cwsyl1 / (Val(ss) + 1))
End If
If d1!ks_id = "06" Then
dd.Range("E11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("I11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("M11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(YRS1)
dd.Range("Q11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS1)
dd.Range("U11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS1)
dd.Range("AC11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS1)
dd.Range("AG11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS1)
dd.Range("AK11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS1)
dd.Range("AS11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XRS1)
dd.Range("Ax11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!bzcsyl1 / (Val(ss) + 1))
dd.Range("bc11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!cwsyl1 / (Val(ss) + 1))
End If
If d1!ks_id = "07" Then
dd.Range("E12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("I12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("M12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(YRS1)
dd.Range("Q12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS1)
dd.Range("U12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS1)
dd.Range("AC12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS1)
dd.Range("AG12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS1)
dd.Range("AK12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS1)
dd.Range("AS12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XRS1)
dd.Range("Ax12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!bzcsyl1 / (Val(ss) + 1))
dd.Range("bc12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!cwsyl1 / (Val(ss) + 1))
End If
If d1!ks_id = "41" Then
dd.Range("E13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("I13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("M13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(YRS1)
dd.Range("Q13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS1)
dd.Range("U13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS1)
dd.Range("AC13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS1)
dd.Range("AG13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS1)
dd.Range("AK13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS1)
dd.Range("AS13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XRS1)
dd.Range("Ax13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!bzcsyl1 / (Val(ss) + 1))
dd.Range("bc13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!cwsyl1 / (Val(ss) + 1))
End If
If d1!ks_id = "08" Then
dd.Range("E14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("I14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("M14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(YRS1)
dd.Range("Q14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS1)
dd.Range("U14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS1)
dd.Range("AC14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS1)
dd.Range("AG14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS1)
dd.Range("AK14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS1)
dd.Range("AS14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XRS1)
dd.Range("Ax14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!bzcsyl1 / (Val(ss) + 1))
dd.Range("bc14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!cwsyl1 / (Val(ss) + 1))
End If
If d1!ks_id = "09" Then
dd.Range("E15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("I15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("M15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(YRS1)
dd.Range("Q15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!RYRS1)
dd.Range("U15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZRRS1)
dd.Range("AC15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CYRS1)
dd.Range("AG15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SWS1)
dd.Range("AK15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZCRS1)
dd.Range("AS15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XRS1)
dd.Range("Ax15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!bzcsyl1 / (Val(ss) + 1))
dd.Range("bc15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!cwsyl1 / (Val(ss) + 1))
End If
d1.MoveNext
Loop
d1.Close
Set d1 = db.OpenRecordset("SELECT sum(dz1) as dz1s,sum(dz2) as dz2s,sum(fs1) as fs1s,sum(fs2) as fs2s," + _
"sum(jy1) as jy1s,sum(jy2) as jy2s,sum(jy3) as jy3s,sum(jy4) as jy4s,sum(qj1) as qj1s,sum(qj2) as qj2s," + _
"sum(ct1) as ct1s,sum(ct2) as ct2s,sum(jz1) as jz1s,sum(jz2) as jz2s,sum(jz3) as jz3s,sum(bl) as bls," + _
"sum(ll) as lls,sum(n1) as n1s,sum(n2) as n2s,sum(n3) as n3s,sum(n4) as n4s,sum(n5) as n5s,sum(w1) as w1s," + _
"sum(w2) as w2s,sum(w3) as w3s,sum(w4) as w4s,sum(wg) as wgs,sum(fc) as fcs,sum(pf) as pfs,sum(zy) as zys," + _
"sum(ek) as eks,sum(sq) as sqs,sum(jz) as jzs,sum(qt) as qts FROM BFRB_TWO WHERE RB_DATE >=CDATE('" + CStr(DATE1) + "') AND RB_DATE<=CDATE('" + CStr(DATE2 + 1) + "')")
If d1.EOF Then
d1.Close
GoTo DDSS
End If
dd.Range("E21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!DZ1s)
dd.Range("H21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!DZ2s)
dd.Range("K21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!FS1s)
dd.Range("N21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!FS2s)
dd.Range("Q21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JY1s)
dd.Range("T21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JY2s)
dd.Range("W21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JY3s)
dd.Range("Z21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JY4s)
dd.Range("AC21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!QJ1s)
dd.Range("AF21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!QJ2s)
dd.Range("AI21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CT1s)
dd.Range("AL21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!CT2s)
dd.Range("AO21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JZ1s)
dd.Range("AR21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JZ2s)
dd.Range("AU21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JZ3s)
dd.Range("AX21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!BLs)
dd.Range("BA21").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!LLs)
dd.Range("A24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!N1s)
dd.Range("D24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!N2s)
dd.Range("G24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!N3s)
dd.Range("J24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!N4s)
dd.Range("M24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!N5s)
dd.Range("P24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!W1s)
dd.Range("S24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!W2s)
dd.Range("V24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!W3s)
dd.Range("Y24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!W4s)
dd.Range("AB24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!WGs)
dd.Range("AE24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!FCs)
dd.Range("AH24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!PFs)
dd.Range("AK24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!ZYs)
dd.Range("AN24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!EKs)
dd.Range("AQ24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!SQs)
dd.Range("AT24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!JZs)
dd.Range("AW24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!QTs)
'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 BCYB(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(xRS) AS XRS1,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")
dd.Workbooks.Open ("C:\PP\SB\病床利用情况统计表")
dd.Range("J2").Select: dd.ActiveCell.FormulaR1C1 = " 统计区间：" + CStr(DATE1) + " 至 " + CStr(DATE2)
dd.Range("B17").Select: dd.ActiveCell.FormulaR1C1 = "" '制 表：" + Form3.sbar.Panels(2) + " " + CStr(Date) + " " + CStr(Time)
dd.Range("B5").Select: dd.ActiveCell.FormulaR1C1 = Val(ss) + 1
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 DESC")
XRS1 = DxCStr(d2!XRS)
XYC1 = DxCStr(d2!XYC)
BZC1 = DxCStr(d2!BZC)
d2.Close
If d1!ks_id = "01" Then
dd.Range("C5").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))
dd.Range("D5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("E5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("F5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS1)
dd.Range("G5").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(ss) + 1)
If Val(BZC1) = 0 Then
BZC1 = 1
End If
If Val(XYC1) = 0 Then
XYC1 = 1
End If
dd.Range("H5").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(BZC1))
dd.Range("I5").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(XYC1))
If Val(DxCStr(d1!XRS1)) = 0 Then
Else
dd.Range("J5").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) * (Val(ss) + 1) / Val(DxCStr(d1!XRS1))
End If
dd.Range("K5").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(BZC1))
dd.Range("L5").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(XYC1))
dd.Range("M5").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(BZC1))
dd.Range("N5").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(XYC1))
End If
If d1!ks_id = "02" Then
dd.Range("C6").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))
dd.Range("D6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("E6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("F6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS1)
dd.Range("G6").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(ss) + 1)
If Val(BZC1) = 0 Then
BZC1 = 1
End If
If Val(XYC1) = 0 Then
XYC1 = 1
End If
dd.Range("H6").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(BZC1))
dd.Range("I6").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(XYC1))
If Val(DxCStr(d1!XRS1)) = 0 Then
Else
dd.Range("J6").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) * (Val(ss) + 1) / Val(DxCStr(d1!XRS1))
End If
dd.Range("K6").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(BZC1))