dlgksgzl.frm

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

    ReDim arrResult(1 To rstemp.RecordCount, 1 To 2)
    rstemp.MoveFirst
    For i = 1 To rstemp.RecordCount
        arrResult(i, 1) = rstemp(0)
        If mblnKShi Then
            arrResult(i, 2) = rstemp(1)
        Else
            arrResult(i, 2) = rstemp(3)
        End If
        
        rstemp.MoveNext
    Next
    
    '刷新网格
    RefreshGrid Me, Me.MSHFlexGrid1, strSQL, False
    mstrSQL = strSQL
    '启用打印按钮
    cmdPrint.Enabled = True

    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub

Private Sub Form_Load()
    dtpBegin.Value = Date
    dtpStop.Value = Date
End Sub

Private Sub XPCommandButton1_Click()
    Unload Me
End Sub

Public Sub PrintReport()
On Error GoTo Print_Cancel
    Dim Status
    Dim Msg As String
    Dim PrintNummber As Integer
    Dim i As Integer, j As Integer
    Dim strHealthID As String
    Dim strBBID As String
    
    '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
    '                                  是否已经注册
    '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
    If gblnRegister = False Then
        MsgBox "您使用的是未注册版本，不能使用该功能，请通过“系统设置”->“系统注册”进行注册！", vbInformation, "提示"
        Exit Sub
    End If
    '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
    
    CommonDialog1.CancelError = True
    CommonDialog1.Flags = cdlPDCollate Or cdlPDNoSelection     ' cdlPDUseDevModeCopies
     'CommonDialog1.Flags = cdlPDPageNums
    CommonDialog1.Min = 1
    CommonDialog1.Max = 1
    CommonDialog1.FromPage = 1
    CommonDialog1.ToPage = 1
    
    CommonDialog1.ShowPrinter
On Error Resume Next
    Printer.Copies = CommonDialog1.Copies
    If Printer.Copies < 1 Then Printer.Copies = 1
    '纵向走纸
    Printer.Orientation = cdlPortrait
On Error GoTo Print_Cancel
    '设成A4纸
    Printer.ScaleMode = vbMillimeters
    Printer.ScaleWidth = 210
    Printer.ScaleHeight = 297
    
    '调用打印程序
    PrintGZLTJ mstrSQL, dtpBegin.Value, dtpStop.Value
    
'    If MsgBox("已经就绪,立即打印吗?", vbYesNo + vbQuestion + vbDefaultButton1, "打印提示") = vbYes Then
'       Printer.EndDoc
'    Else
'       Printer.KillDoc
'    End If
    Exit Sub
Print_Cancel:
    MousePointer = vbDefault
    If Err.Number <> cdlCancel Then
        Status = SetError(Err.Number, "无法完成打印，请确认打印机电源已经开启并与计算机正确连接！:" _
                & vbCrLf & Err.Description, Err.Source)
        ErrMsg Status
    End If
End Sub

'打印科室/医生工作量统计
Public Sub PrintGZLTJ(ByVal strSQL As String, ByVal dtmBegin As Date, dtmStop As Date)
On Error Resume Next
    Dim rstemp As ADODB.Recordset
    Dim i As Integer
    Dim lngTotal As Long
    
    Dim intPage As Integer
    Dim sngCurrY As Single
    Dim intCurrLine As Integer
    
    Dim sngTitleTop As Single
    Dim sngHospitalTop As Single
    
    Dim sngPersonTop As Single
    Dim sngTextLeft As Single
    Dim sngHeaderTop As Single
    Dim sngTextTop As Single
    Dim sngTextBottom As Single
    Dim sngPageNumberTop As Single
    
    '科室工作量统计
    Dim sngKeShiFirstCol As Single
    Dim sngKeShiSecondCol As Single
    Dim sngKeShiThirdCol As Single
    
    '医生工作量统计
    Dim sngDoctorFirstCol As Single
    Dim sngDoctorSecondCol As Single
    Dim sngDoctorThirdCol As Single
    Dim sngDoctorFourthCol As Single
    
    Me.MousePointer = vbHourglass
    
    sngTitleTop = 25
    sngHospitalTop = 34
    sngPersonTop = 42
    sngTextLeft = 40
    sngHeaderTop = 52
    sngTextTop = 59
    sngTextBottom = 272
    sngPageNumberTop = 285
    
    '科室工作量统计
    sngKeShiFirstCol = 40
    sngKeShiSecondCol = 90
    sngKeShiThirdCol = 140
    
    '医生工作量统计
    sngDoctorFirstCol = 40
    sngDoctorSecondCol = 60
    sngDoctorThirdCol = 105
    sngDoctorFourthCol = 140
    
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If rstemp.EOF Then
        MsgBox "没有需要打印的内容，请重新设置时间范围！", vbInformation, "提示"
        GoTo ExitLab
    End If
    
    intPage = 1 '从第一页开始
    '打印第一页的标题
    GoSub PrintTitle

    rstemp.MoveFirst
    With Printer
        '打印报表正文
        '循环打印所有记录
        intCurrLine = 1
        For i = 1 To rstemp.RecordCount
            .FontSize = 9
            .FontBold = False
            '计算纵坐标
            sngCurrY = sngTextTop + (intCurrLine - 1) * .TextHeight("高度") * 1.5
            If sngCurrY > sngTextBottom Then '该分页
                Printer.NewPage
                intPage = intPage + 1
                GoSub PrintTitle
                
                intCurrLine = 1
                .FontSize = 9
                .FontBold = False
                '分页后重新计算纵坐标
                sngCurrY = sngTextTop + (intCurrLine - 1) * .TextHeight("高度") * 1.5
            End If
            
            If mblnKShi Then
                '**************************************************************
                '                           科室工作量统计
                '**************************************************************
                .CurrentX = sngKeShiFirstCol
                .CurrentY = sngCurrY
                Printer.Print rstemp(0)
                
                .CurrentX = sngKeShiSecondCol
                .CurrentY = sngCurrY
                Printer.Print rstemp(1)
                
                .CurrentX = sngKeShiThirdCol
                .CurrentY = sngCurrY
                Printer.Print rstemp(2) & ""
            
                If Not IsNull(rstemp(2)) Then
                    lngTotal = lngTotal + rstemp(2)
                End If
            Else
                '**************************************************************
                '                           医生工作量统计
                '**************************************************************
                .CurrentX = sngDoctorFirstCol
                .CurrentY = sngCurrY
                Printer.Print rstemp(0)
                
                .CurrentX = sngDoctorSecondCol
                .CurrentY = sngCurrY
                Printer.Print rstemp(1)
                
                .CurrentX = sngDoctorThirdCol
                .CurrentY = sngCurrY
                Printer.Print rstemp(2)
                
                .CurrentX = sngDoctorFourthCol
                .CurrentY = sngCurrY
                Printer.Print rstemp(3)
                
                If Not IsNull(rstemp(3)) Then
                    lngTotal = lngTotal + rstemp(3)
                End If
            End If
            
            intCurrLine = intCurrLine + 1
            rstemp.MoveNext
        Next
        
        '在最后一页上打印合计
        .FontSize = 9
        .FontBold = True
        sngCurrY = sngTextTop + (intCurrLine - 1) * .TextHeight("高度") * 1.5 + 5
        Printer.Line (sngTextLeft - 5, sngCurrY - 1.5)-(sngTextLeft + 120, sngCurrY - 1.5)
        .CurrentX = sngTextLeft
        .CurrentY = sngCurrY
        Printer.Print "合计："
        
        .CurrentX = sngTextLeft + 100
        .CurrentY = sngCurrY
        Printer.Print lngTotal
        
        '提交打印
        Printer.EndDoc
    End With
    GoTo ExitLab

'打印报表标题
PrintTitle:
    With Printer
        '打印标题
        .FontName = "宋体"
        .FontSize = 17
        .FontBold = True
        .FontItalic = False
        .FontUnderline = False
        
        .CurrentX = (Printer.ScaleWidth - .TextWidth("科室工作量统计")) / 2
        .CurrentY = sngTitleTop
        If mblnKShi = True Then
            Printer.Print "科室工作量统计"
        Else
            Printer.Print "医生工作量统计"
        End If
        
        '打印单位
        .FontSize = 11
        .CurrentX = (Printer.ScaleWidth - .TextWidth(gstrHospital)) / 2
        .CurrentY = sngHospitalTop
        Printer.Print gstrHospital
        
        '打印起始日期
        .FontSize = 9
        .CurrentX = (Printer.ScaleWidth - .TextWidth("(" & dtmBegin & " 至 " & dtmStop & ")")) / 2
        .CurrentY = sngPersonTop
        Printer.Print "(" & dtmBegin & " 至 " & dtmStop & ")"
        
        '打印报表题头
        Printer.DrawWidth = 5
        Printer.Line (sngTextLeft - 5, sngHeaderTop - 1.5)-(sngTextLeft + 120, sngHeaderTop - 1.5)
        
        .CurrentX = sngTextLeft
        .CurrentY = sngHeaderTop
        If mblnKShi = True Then
            Printer.Print "项目组合"
        Else
            Printer.Print "工作人员"
        End If
        
        If mblnKShi Then
            .CurrentX = sngKeShiSecondCol
            .CurrentY = sngHeaderTop
            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
    
ExitLab:
    Me.MousePointer = vbDefault
End Sub