⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 module2.bas

📁 这是一个医院管理系统中的院长查询模块
💻 BAS
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
Do While Not d1.EOF
CZYM(i) = "  /" + Left(CStr(d1!CZY_NAME), 3) + ":" + CStr(Format(d1!SK_SUM + d1!TK_SUM + d1!GHSK + d1!GHTK, "0.00"))
CZYMM = CZYMM + CZYM(i)
i = i + 1
d1.MoveNext
Loop
d1.Close
CZYL = i - 1
Set d1 = db.OpenRecordset("SELECT SUM(MZ_LC) AS LCS,SUM(CF_LC) AS CFLCS,SUM(CF_MONEY) AS CFJE,SUM(HJ_MONEY) AS HJS FROM MZ_RB WHERE RB_DATE=CDATE('" + CStr(DATES) + "')")
If IsNull(d1!LCS) Then
LCS = 0
Else
LCS = d1!LCS
End If
If IsNull(d1!CFJE) Then
CFJES = 0
Else
CFJES = d1!CFJE
End If
If IsNull(d1!CFLCS) Then
CFLCS = 0
Else
CFLCS = d1!CFLCS
End If
If IsNull(d1!Hjs) Then
Hjs = 0
Else
Hjs = d1!Hjs
End If
d1.Close
Set d1 = db.OpenRecordset("SELECT * FROM MZ_RB WHERE RB_DATE=CDATE('" + CStr(DATES) + "') ORDER BY KS_ID")
Do While Not d1.EOF
KSID(F_HJ) = d1!ks_id
KSNAME(F_HJ) = d1!ks_name
d1.MoveNext
F_HJ = F_HJ + 1
Loop
d1.Close
F_HJ = F_HJ - 1
P_PAGE = (F_HJ + 5) \ 6
If P_PAGE = F_HJ / 6 Then
P_PAGE = P_PAGE + 1
End If
KSID(P_PAGE * 6) = "99"
KSNAME(P_PAGE * 6) = "合   计"
Set dd = CreateObject("Excel.Application")
dd.Workbooks.Open ("C:\PP\MZRB")
j = 1
If CDate(DATE1) = CDate("2000-01-01") Then
DATE1 = "    -  -  "
End If
For KK = 1 To P_PAGE
dd.Range("A1").Select: dd.ActiveCell.FormulaR1C1 = " 爱龄奇医院[" + CStr(DATES) + "]门诊收入日报表（" + CStr(P_PAGE) + "." + CStr(KK) + "）"
dd.Range("B2").Select: dd.ActiveCell.FormulaR1C1 = "统计日期[" + Left(CStr(DATE2), 10) + "]统计时间[" _
+ Right(CStr(DATE2), 8) + "]数据期间[" + Left(CStr(DATE1), 10) + "至" + Left(CStr(DATE2), 10) + _
"] 门诊量次[" + CStr(LCS) + "]，冲方量次[" + CStr(CFLCS) + "]，冲方金额[" + CStr(CFJES) + "]      打印日期[" + CStr(Date) + "]"
dd.Range("B39").Select: dd.ActiveCell.FormulaR1C1 = CZYMM
For i = Asc("C") To Asc("M") Step 2
mm = Chr(i) + "3:" + Chr(i + 1) + "3"
dd.Range(mm).Select: dd.ActiveCell.FormulaR1C1 = KSNAME(j)
j = j + 1
If KSID(j - 1) = "99" Then
SSSM = "SUM(A1) AS AA1,SUM(B1) AS BB1"
For G = 2 To 24
SSSM = SSSM + ",SUM(A" + CStr(G) + ") AS AA" + CStr(G)
SSSM = SSSM + ",SUM(B" + CStr(G) + ") AS BB" + CStr(G)
Next G
Set d1 = db.OpenRecordset("SELECT " + SSSM + " FROM MZ_RB WHERE RB_DATE=CDATE('" + CStr(DATES) + "')")
dd.Range(Chr(i) + "4").Select: dd.ActiveCell.FormulaR1C1 = "量 次"
dd.Range(Chr(i) + "5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!aa1)
dd.Range(Chr(i) + "6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!aa2)
dd.Range(Chr(i) + "7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA3)
dd.Range(Chr(i) + "8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA4)
dd.Range(Chr(i) + "10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA5)
dd.Range(Chr(i) + "11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA6)
dd.Range(Chr(i) + "12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA7)
dd.Range(Chr(i) + "14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA8)
dd.Range(Chr(i) + "15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA9)
dd.Range(Chr(i) + "17").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA10)
dd.Range(Chr(i) + "18").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA11)
dd.Range(Chr(i) + "19").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA12)
dd.Range(Chr(i) + "20").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA13)
dd.Range(Chr(i) + "22").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA14)
dd.Range(Chr(i) + "23").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA15)
dd.Range(Chr(i) + "24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA16)
dd.Range(Chr(i) + "26").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA17)
dd.Range(Chr(i) + "27").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA18)
dd.Range(Chr(i) + "29").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA19)
dd.Range(Chr(i) + "31").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA20)
dd.Range(Chr(i) + "32").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA21)
dd.Range(Chr(i) + "33").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA22)
dd.Range(Chr(i) + "35").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA24)
dd.Range(Chr(i) + "37").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA23)
II = i + 1
dd.Range(Chr(II) + "4").Select: dd.ActiveCell.FormulaR1C1 = "金  额"
dd.Range(Chr(II) + "5").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB1)
dd.Range(Chr(II) + "6").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB2)
dd.Range(Chr(II) + "7").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB3)
dd.Range(Chr(II) + "8").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB4)
dd.Range(Chr(II) + "10").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB5)
dd.Range(Chr(II) + "11").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB6)
dd.Range(Chr(II) + "12").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB7)
dd.Range(Chr(II) + "14").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB8)
dd.Range(Chr(II) + "15").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB9)
dd.Range(Chr(II) + "17").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB10)
dd.Range(Chr(II) + "18").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB11)
dd.Range(Chr(II) + "19").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB12)
dd.Range(Chr(II) + "20").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB13)
dd.Range(Chr(II) + "22").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB14)
dd.Range(Chr(II) + "23").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB15)
dd.Range(Chr(II) + "24").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB16)
dd.Range(Chr(II) + "26").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB17)
dd.Range(Chr(II) + "27").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB18)
dd.Range(Chr(II) + "29").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB19)
dd.Range(Chr(II) + "31").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB20)
dd.Range(Chr(II) + "32").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB21)
dd.Range(Chr(II) + "33").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB22)
dd.Range(Chr(II) + "35").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB24)
dd.Range(Chr(II) + "37").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB23)
d1.Close
Else
Set d1 = db.OpenRecordset("SELECT * FROM MZ_RB WHERE KS_ID='" + KSID(j - 1) + "' AND RB_DATE=CDATE('" + CStr(DATES) + "')")
If d1.EOF Then
For HHH = 4 To 37
dd.Range(Chr(i) + CStr(HHH)).Select: dd.ActiveCell.FormulaR1C1 = ""
dd.Range(Chr(i + 1) + CStr(HHH)).Select: dd.ActiveCell.FormulaR1C1 = ""
Next HHH
Else
dd.Range(Chr(i) + "4").Select: dd.ActiveCell.FormulaR1C1 = "量 次"
dd.Range(Chr(i) + "5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A1)
dd.Range(Chr(i) + "6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A2)
dd.Range(Chr(i) + "7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A3)
dd.Range(Chr(i) + "8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A4)
dd.Range(Chr(i) + "10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A5)
dd.Range(Chr(i) + "11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!a6)
dd.Range(Chr(i) + "12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A7)
dd.Range(Chr(i) + "14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A8)
dd.Range(Chr(i) + "15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A9)
dd.Range(Chr(i) + "17").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A10)
dd.Range(Chr(i) + "18").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A11)
dd.Range(Chr(i) + "19").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A12)
dd.Range(Chr(i) + "20").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A13)
dd.Range(Chr(i) + "22").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A14)
dd.Range(Chr(i) + "23").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A15)
dd.Range(Chr(i) + "24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A16)
dd.Range(Chr(i) + "26").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A17)
dd.Range(Chr(i) + "27").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A18)
dd.Range(Chr(i) + "29").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A19)
dd.Range(Chr(i) + "31").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A20)
dd.Range(Chr(i) + "32").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A21)
dd.Range(Chr(i) + "33").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A22)
dd.Range(Chr(i) + "35").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A24)
dd.Range(Chr(i) + "37").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!A23)
II = i + 1
dd.Range(Chr(II) + "4").Select: dd.ActiveCell.FormulaR1C1 = "金  额"
dd.Range(Chr(II) + "5").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!b1)
dd.Range(Chr(II) + "6").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!b2)
dd.Range(Chr(II) + "7").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!b3)
dd.Range(Chr(II) + "8").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B4)
dd.Range(Chr(II) + "10").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B5)
dd.Range(Chr(II) + "11").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B6)
dd.Range(Chr(II) + "12").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B7)
dd.Range(Chr(II) + "14").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B8)
dd.Range(Chr(II) + "15").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B9)
dd.Range(Chr(II) + "17").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B10)
dd.Range(Chr(II) + "18").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B11)
dd.Range(Chr(II) + "19").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B12)
dd.Range(Chr(II) + "20").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B13)
dd.Range(Chr(II) + "22").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B14)
dd.Range(Chr(II) + "23").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B15)
dd.Range(Chr(II) + "24").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B16)
dd.Range(Chr(II) + "26").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B17)
dd.Range(Chr(II) + "27").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B18)
dd.Range(Chr(II) + "29").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!B19)
dd.Range(Chr(II) + "31").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!B20)
dd.Range(Chr(II) + "32").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!B21)
dd.Range(Chr(II) + "33").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!B22)
dd.Range(Chr(II) + "35").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!B24)
dd.Range(Chr(II) + "37").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!B23)
End If
d1.Close
End If
Next i
dd.Visible = True
dd.ActiveWorkbook.PrintPreview
dd.Visible = True
'dd.ActiveWorkbook.PrintPreview
Next KK
dd.ActiveWorkbook.Saved = True
dd.ActiveWorkbook.Close
dd.Quit
MsgBox "打印完毕!"
End Sub
Sub MZYBS(DATEA As Date, DATEB 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 TOP 1 * FROM MZ_JS WHERE JK_DATE>CDATE('" + CStr(DATEA) + "') AND JK_DATE<=CDATE('" + CStr(DATEB) + "') order by lsh_ID desc")
If d1.EOF Then
d1.Close
MsgBox "请注意，门诊收入无数据！", , "警告"
Exit Sub
End If
DATE1 = DATEA
DATE2 = DATEB
time1 = d1!JS_D2
d1.Close
Set d1 = db.OpenRecordset("SELECT SUM(MZ_LC) AS LCS,SUM(CF_LC) AS CFLCS,SUM(CF_MONEY) AS CFJE,SUM(HJ_MONEY) AS HJS FROM MZ_RB WHERE RB_DATE>CDATE('" + CStr(DATEA) + "') AND RB_DATE<=CDATE('" + CStr(DATEB) + "')")
If IsNull(d1!LCS) Then
LCS = 0
Else
LCS = d1!LCS
End If
If IsNull(d1!CFJE) Then
CFJES = 0
Else
CFJES = d1!CFJE
End If
If IsNull(d1!CFLCS) Then
CFLCS = 0
Else
CFLCS = d1!CFLCS
End If
If IsNull(d1!Hjs) Then
Hjs = 0
Else
Hjs = d1!Hjs
End If
d1.Close
Set d1 = db.OpenRecordset("SELECT KS_ID,KS_NAME,SUM(HJ_MONEY) FROM MZ_RB WHERE RB_DATE>CDATE('" + CStr(DATEA) + "') AND RB_DATE<=CDATE('" + CStr(DATEB) + "') GROUP BY KS_ID,KS_NAME ORDER BY KS_ID")
Do While Not d1.EOF
KSID(F_HJ) = d1!ks_id
KSNAME(F_HJ) = d1!ks_name
d1.MoveNext
F_HJ = F_HJ + 1
Loop
d1.Close
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -