frmtjpq.frm

本系统可用于医院和专业体检中心的健康体检管理

On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim rstemp As ADODB.Recordset
    Dim rsPerson As ADODB.Recordset
    Dim i As Integer, j As Integer, K As Integer
    Dim strLine As String
    Dim intPersons As Integer '每行打印的客户数目
    Dim lngTotal As Long
    
    Dim intFontSize As Integer '正文字体大小
    Dim blnBold As Boolean '是否粗体
    
    Dim intPage As Integer '页码
    Dim sngCurrY As Single '当前的纵坐标
    Dim intCurrLine As Integer '当前行
    
    Dim sngTitleTop As Single
    Dim sngHospitalTop As Single
    
    Dim sngCurLeft As Single
    
    Dim sngPersonTop As Single
    Dim sngTextLeft As Single
    Dim sngBodyText As Single
    Dim sngHeaderTop As Single
    Dim sngTextTop As Single
    Dim sngTextBottom As Single
    Dim sngPageNumberTop As Single
    
    Me.MousePointer = vbHourglass
    
    intPersons = 9
    
    sngTitleTop = 25
    sngHospitalTop = 34
    sngPersonTop = 42
    sngTextLeft = 30
    sngBodyText = sngTextLeft + 3.4
    sngHeaderTop = 52
    sngTextTop = sngHeaderTop '59
    sngTextBottom = 272
    sngPageNumberTop = 285
    
    '首先获取客户的个人信息
    
'    '如果结论和建议都为空，则无需打印
'    If strZJJLun = "" And astrzjjyi = "" Then GoTo ExitLab
    
    intCurrLine = 1 '起始行号
    intPage = 1 '从第一页开始
    '打印第一页的标题
    GoSub PrintTitle
    
    With Printer
        '打印报表正文
        '☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆
        '☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆
        '                           首先打印团检客户
        '☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆
        '☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆
        strSQL = "select YY_TJDJ.*,SET_DW.*" _
                & " from YY_TJDJ,SET_DW" _
                & " where TJRQ='" & dtmDate & "'" _
                & " and YY_TJDJ.DWID=SET_DW.DWID"
'                & " and (SFTJ=0 or SFTJ=1)"
        Set rstemp = New ADODB.Recordset
        rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
        '有预约的团体
        If rstemp.RecordCount > 0 Then
            rstemp.MoveFirst
            '循环处理每个团体
            For K = 1 To rstemp.RecordCount
                '首先打印团体名称
                intFontSize = 9
                blnBold = True
                sngCurLeft = sngTextLeft - 5
                strLine = rstemp("DWMC")
                GoSub PrintLine
                
                '打印该单位的具体人员
                strSQL = "select SET_GRXX.GUID,HealthID,YYRXM,Sex,Age,Status='未检'" _
                        & " from SET_GRXX" _
                        & " where SET_GRXX.YYID='" & rstemp("YYID") & "'"
                Set rsPerson = New ADODB.Recordset
                rsPerson.Open strSQL, GCon, adOpenStatic, adLockReadOnly
                
                intFontSize = 9
                blnBold = False
                sngCurLeft = sngBodyText
                
                If rsPerson.RecordCount < 1 Then
                    '无登记人员
                    intCurrLine = intCurrLine + 1
                    strLine = "（无登记人员）"
                    GoSub PrintLine
                Else
                    '有登记人员
                    j = 0
                    intCurrLine = intCurrLine + 1
                    For i = 1 To rsPerson.RecordCount
                        j = j + 1
                        sngCurLeft = sngBodyText + (j - 1) * .TextWidth("作者吴明远")
                        strLine = rsPerson("YYRXM")
                        GoSub PrintLine
                        
                        '每行打印intPersons个客户
                        If (j >= intPersons) Or (i = rsPerson.RecordCount) Then
                            j = 0
                            '如果不是最后一行，则换行
                            If i < rsPerson.RecordCount Then
                                intCurrLine = intCurrLine + 1
                            End If
                        End If
                        
                        rsPerson.MoveNext
                    Next i
                    
                    '打印合计
                    intCurrLine = intCurrLine + 1
                    blnBold = True
                    sngCurLeft = sngBodyText
                    strLine = "小计：" & rsPerson.RecordCount & " 人"
                    GoSub PrintLine
                    lngTotal = lngTotal + rsPerson.RecordCount
                    
                    rsPerson.Close
                End If
                
                intCurrLine = intCurrLine + 1
                rstemp.MoveNext
            Next K
            
            intCurrLine = intCurrLine + 1 '为了后面空一行打印散检
        End If
        
        '☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆
        '☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆
        '                               打印散检客户
        '☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆
        '☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆
        intFontSize = 9
        blnBold = True
        sngCurLeft = sngTextLeft - 5
        strLine = "散检客户："
        GoSub PrintLine
        
        strSQL = "select SET_GRXX.GUID,HealthID,YYRXM,Sex,Age,Status='未检'" _
                & " from SET_GRXX" _
                & " where ((YYID is null) or (YYID=''))" _
                & " and SET_GRXX.TJRQ='" & dtmDate & "'"
        Set rsPerson = New ADODB.Recordset
        rsPerson.Open strSQL, GCon, adOpenStatic, adLockReadOnly
        
        intFontSize = 9
        blnBold = False
        sngCurLeft = sngBodyText
        
        If rsPerson.RecordCount < 1 Then
            '无登记人员
            intCurrLine = intCurrLine + 1
            strLine = "（无登记人员）"
            GoSub PrintLine
        Else
            '有登记人员
            j = 0
            intCurrLine = intCurrLine + 1
            For i = 1 To rsPerson.RecordCount
                j = j + 1
                sngCurLeft = sngBodyText + (j - 1) * .TextWidth("作者吴明远")
                strLine = rsPerson("YYRXM")
                GoSub PrintLine
                
                '每行打印intPersons个客户
                If (j >= intPersons) Or (i = rsPerson.RecordCount) Then
                    j = 0
                    '如果不是最后一行，则换行
                    If i < rsPerson.RecordCount Then
                        intCurrLine = intCurrLine + 1
                    End If
                End If
                
                rsPerson.MoveNext
            Next i
            
            '打印合计
            intCurrLine = intCurrLine + 1
            blnBold = True
            sngCurLeft = sngBodyText
            strLine = "小计：" & rsPerson.RecordCount & " 人"
            GoSub PrintLine
            lngTotal = lngTotal + rsPerson.RecordCount
            
            rsPerson.Close
        End If

        '打印总的合计人数
        '打印合计
        intCurrLine = intCurrLine + 2
        blnBold = True
        sngCurLeft = sngTextLeft - 5
        strLine = dtmDate & " 总计：" & lngTotal & " 人"
        GoSub PrintLine
        
        '每个客户提交一次打印
        Printer.EndDoc
    End With
    
    GoTo ExitLab

'打印某一行
PrintLine:
    With Printer
        .FontSize = intFontSize
        .FontBold = False
        '计算纵坐标
        sngCurrY = sngTextTop + (intCurrLine - 1) * .TextHeight("高度") * 1.5
        If sngCurrY > sngTextBottom Then '该分页
            Printer.NewPage
            intPage = intPage + 1
            GoSub PrintTitle
            
            intCurrLine = 1
            .FontSize = intFontSize
            .FontBold = False
            '分页后重新计算纵坐标
            sngCurrY = sngTextTop + (intCurrLine - 1) * .TextHeight("高度") * 1.5
        End If
        .CurrentX = sngCurLeft
        .CurrentY = sngCurrY
        .FontBold = blnBold
        Printer.Print strLine
    End With
    Return

'打印报表标题
PrintTitle:
    With Printer
        '打印标题
        .FontName = "宋体"
        .FontSize = 17
        .FontBold = True
        .FontItalic = False
        .FontUnderline = False
        
        .CurrentX = (Printer.ScaleWidth - .TextWidth(dtmDate & " 人员名单")) / 2
        .CurrentY = sngTitleTop
        Printer.Print dtmDate & " 人员名单"
        
        '打印单位
        .FontSize = 11
        .CurrentX = (Printer.ScaleWidth - .TextWidth(gstrHospital)) / 2
        .CurrentY = sngHospitalTop
        Printer.Print gstrHospital
        
        '打印个人信息
'        .FontSize = 9
'        .CurrentX = sngTextLeft - 5
'        .CurrentY = sngPersonTop
'        Printer.Print "档案号：" & strHealthID
'
'        .CurrentX = sngTextLeft + 43 - 5
'        .CurrentY = sngPersonTop
'        Printer.Print "姓名：" & strName
'
'        .CurrentX = sngTextLeft + 75 - 5
'        .CurrentY = sngPersonTop
'        Printer.Print "性别：" & strSex
'
        .FontSize = 9
        .CurrentX = (Printer.ScaleWidth - .TextWidth("打印时间：" & Date & Space(5) & Time)) / 2
        .CurrentY = sngPersonTop
        Printer.Print "打印时间：" & Date & Space(5) & Time
        
        '打印报表题头
        Printer.DrawWidth = 5
        Printer.Line (sngTextLeft - 5, sngHeaderTop - 1.5)-(sngTextLeft + 158, sngHeaderTop - 1.5)
        
'        .CurrentX = sngTextLeft
'        .CurrentY = sngHeaderTop
'        If mblnKShi = True Then
'            Printer.Print "科室名称"
'        Else
'            Printer.Print "工作人员"
'        End If
'
'        .CurrentX = sngTextLeft + 100
'        .CurrentY = sngHeaderTop
'        Printer.Print "工作量(人次)"
'        Printer.Line (sngTextLeft - 5, sngHeaderTop + .TextHeight("高度") + 1)-(sngTextLeft + 120, sngHeaderTop + .TextHeight("高度") + 1)
'
        '打印页码
        .CurrentX = (Printer.ScaleWidth - .TextWidth(str(intPage))) / 2
        .CurrentY = sngPageNumberTop
        Printer.Print intPage
    End With
    Return
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub