module2.bas

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

dd.Range("L6").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(XYC1))
dd.Range("M6").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(BZC1))
dd.Range("N6").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(XYC1))
End If
If d1!ks_id = "03" Then
dd.Range("C7").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))
dd.Range("D7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("E7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("F7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS1)
dd.Range("G7").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("H7").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(BZC1))
dd.Range("I7").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(XYC1))
If Val(DxCStr(d1!XRS1)) = 0 Then
Else
dd.Range("J7").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) * (Val(ss) + 1) / Val(DxCStr(d1!XRS1))
End If
dd.Range("K7").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(BZC1))
dd.Range("L7").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(XYC1))
dd.Range("M7").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(BZC1))
dd.Range("N7").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(XYC1))
End If
If d1!ks_id = "04" Then
dd.Range("C8").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))
dd.Range("D8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("E8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("F8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS1)
dd.Range("G8").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("H8").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(BZC1))
dd.Range("I8").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(XYC1))
If Val(DxCStr(d1!XRS1)) = 0 Then
Else
dd.Range("J8").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) * (Val(ss) + 1) / Val(DxCStr(d1!XRS1))
End If
dd.Range("K8").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(BZC1))
dd.Range("L8").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(XYC1))
dd.Range("M8").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(BZC1))
dd.Range("N8").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(XYC1))
End If
If d1!ks_id = "40" Then
dd.Range("C9").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))
dd.Range("D9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("E9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("F9").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS1)
dd.Range("G9").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("H9").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(BZC1))
dd.Range("I9").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(XYC1))
If Val(DxCStr(d1!XRS1)) = 0 Then
Else
dd.Range("J9").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) * (Val(ss) + 1) / Val(DxCStr(d1!XRS1))
End If
dd.Range("K9").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(BZC1))
dd.Range("L9").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(XYC1))
dd.Range("M9").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(BZC1))
dd.Range("N9").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(XYC1))
End If
If d1!ks_id = "05" Then
dd.Range("C10").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))
dd.Range("D10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("E10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("F10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS1)
dd.Range("G10").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("H10").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(BZC1))
dd.Range("I10").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(XYC1))
If Val(DxCStr(d1!XRS1)) = 0 Then
Else
dd.Range("J10").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) * (Val(ss) + 1) / Val(DxCStr(d1!XRS1))
End If
dd.Range("K10").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(BZC1))
dd.Range("L10").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(XYC1))
dd.Range("M10").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(BZC1))
dd.Range("N10").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(XYC1))
End If
If d1!ks_id = "06" Then
dd.Range("C11").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))
dd.Range("D11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("E11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("F11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS1)
dd.Range("G11").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("H11").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(BZC1))
dd.Range("I11").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(XYC1))
If Val(DxCStr(d1!XRS1)) = 0 Then
Else
dd.Range("J11").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) * (Val(ss) + 1) / Val(DxCStr(d1!XRS1))
End If
dd.Range("K11").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(BZC1))
dd.Range("L11").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(XYC1))
dd.Range("M11").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(BZC1))
dd.Range("N11").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(XYC1))
End If
If d1!ks_id = "07" Then
dd.Range("C12").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))
dd.Range("D12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("E12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("F12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS1)
dd.Range("G12").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("H12").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(BZC1))
dd.Range("I12").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(XYC1))
If Val(DxCStr(d1!XRS1)) = 0 Then
Else
dd.Range("J12").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) * (Val(ss) + 1) / Val(DxCStr(d1!XRS1))
End If
dd.Range("K12").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(BZC1))
dd.Range("L12").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(XYC1))
dd.Range("M12").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(BZC1))
dd.Range("N12").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(XYC1))
End If
If d1!ks_id = "41" Then
dd.Range("C13").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))
dd.Range("D13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("E13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("F13").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS1)
dd.Range("G13").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("H13").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(BZC1))
dd.Range("I13").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(XYC1))
If Val(DxCStr(d1!XRS1)) = 0 Then
Else
dd.Range("J13").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) * (Val(ss) + 1) / Val(DxCStr(d1!XRS1))
End If
dd.Range("K13").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(BZC1))
dd.Range("L13").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(XYC1))
dd.Range("M13").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(BZC1))
dd.Range("N13").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(XYC1))
End If
If d1!ks_id = "08" Then
dd.Range("C14").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))
dd.Range("D14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("E14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("F14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS1)
dd.Range("G14").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("H14").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(BZC1))
dd.Range("I14").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(XYC1))
If Val(DxCStr(d1!XRS1)) = 0 Then
Else
dd.Range("J14").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) * (Val(ss) + 1) / Val(DxCStr(d1!XRS1))
End If
dd.Range("K14").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(BZC1))
dd.Range("L14").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(XYC1))
dd.Range("M14").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(BZC1))
dd.Range("N14").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(XYC1))
End If
If d1!ks_id = "09" Then
dd.Range("C15").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))
dd.Range("D15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(BZC1)
dd.Range("E15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(XYC1)
dd.Range("F15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!XRS1)
dd.Range("G15").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("H15").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(BZC1))
dd.Range("I15").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / ((Val(ss) + 1) * Val(XYC1))
If Val(DxCStr(d1!XRS1)) = 0 Then
Else
dd.Range("J15").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) * (Val(ss) + 1) / Val(DxCStr(d1!XRS1))
End If
dd.Range("K15").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(BZC1))
dd.Range("L15").Select: dd.ActiveCell.FormulaR1C1 = Val(DxCStr(d1!XRS1)) / (Val(XYC1))
dd.Range("M15").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(BZC1))
dd.Range("N15").Select: dd.ActiveCell.FormulaR1C1 = (Val(DxCStr(d1!CYRS1)) + Val(DxCStr(d1!SWS1))) / Val(DxCStr(XYC1))
End If
d1.MoveNext
Loop
d1.Close
DDSS:
dd.Visible = True
dd.ActiveWorkbook.PrintPreview
dd.ActiveWorkbook.Saved = True
dd.ActiveWorkbook.Close
dd.Quit
End Sub


Sub MZRB(DATES As Date)
Dim d1 As Recordset
Dim d2 As Recordset
Dim dd As Excel.Application
Dim CZYM(20) As String
Dim KSID(50) As String
Dim KSNAME(50) As String
For i = 1 To 50
KSID(i) = " "
KSNAME(i) = " "
Next i
F_HJ = 1
Set d1 = db.OpenRecordset("SELECT * FROM MZ_JS WHERE JK_DATE=CDATE('" + CStr(DATES) + "')")
If d1.EOF Then
d1.Close
MsgBox "请注意，门诊收入日汇总表未打印或今天无数据！", , "警告"
Exit Sub
End If
DATE1 = d1!JS_D1
DATE2 = d1!JS_D2
i = 1
CZYMM = ""