frmdwtjbgdc.frm

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

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{0B81E4A9-BE4E-4AEF-9272-33AB5B51C6FC}#1.0#0"; "XPControls.ocx"
Begin VB.Form FrmDWTJBGDC 
   BackColor       =   &H00D3DABC&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "团检报告导出"
   ClientHeight    =   5880
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9120
   Icon            =   "FrmDWTJBGDC.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5880
   ScaleWidth      =   9120
   StartUpPosition =   1  'CenterOwner
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   1710
      Top             =   -90
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Frame Frame10 
      BackColor       =   &H00D3DABC&
      Caption         =   "导出"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   975
      Left            =   150
      TabIndex        =   4
      Top             =   4815
      Width           =   6330
      Begin VB.CheckBox chkPrintImmediate 
         BackColor       =   &H00D3DABC&
         Caption         =   "导出后立即打印"
         Height          =   255
         Left            =   1350
         TabIndex        =   7
         Top             =   600
         Width           =   4875
      End
      Begin VB.CheckBox chkDefault 
         BackColor       =   &H00D3DABC&
         Caption         =   "默认文件名(模板名称_团体名称_体检日期.doc)"
         Height          =   285
         Left            =   1350
         TabIndex        =   5
         Top             =   195
         Value           =   1  'Checked
         Width           =   4875
      End
      Begin XPControls.XPCommandButton cmdExport 
         Height          =   420
         Left            =   195
         TabIndex        =   6
         ToolTipText     =   "以WORD格式导出"
         Top             =   330
         Width           =   990
         _ExtentX        =   1746
         _ExtentY        =   741
         Enabled         =   0   'False
         Caption         =   "导  出"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
   End
   Begin VB.Frame Frame8 
      BackColor       =   &H00D3DABC&
      Caption         =   "WORD模板选择"
      Height          =   4530
      Index           =   0
      Left            =   5625
      TabIndex        =   2
      Top             =   135
      Width           =   3330
      Begin MSComctlLib.ListView lvwMB 
         Height          =   4095
         Left            =   135
         TabIndex        =   3
         Top             =   300
         Width           =   3045
         _ExtentX        =   5371
         _ExtentY        =   7223
         View            =   3
         LabelEdit       =   1
         LabelWrap       =   -1  'True
         HideSelection   =   0   'False
         FullRowSelect   =   -1  'True
         GridLines       =   -1  'True
         _Version        =   393217
         ForeColor       =   -2147483640
         BackColor       =   12648384
         BorderStyle     =   1
         Appearance      =   1
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         NumItems        =   2
         BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            Text            =   "模板名称"
            Object.Width           =   2540
         EndProperty
         BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   1
            Text            =   "说明"
            Object.Width           =   2540
         EndProperty
      End
   End
   Begin XPControls.XPCommandButton cmdExit 
      Cancel          =   -1  'True
      Height          =   420
      Left            =   7260
      TabIndex        =   0
      Top             =   5085
      Width           =   1170
      _ExtentX        =   2064
      _ExtentY        =   741
      Caption         =   "退  出"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MSComctlLib.ListView lvwDWei 
      Height          =   4530
      Left            =   150
      TabIndex        =   1
      Top             =   135
      Width           =   5385
      _ExtentX        =   9499
      _ExtentY        =   7990
      View            =   3
      LabelEdit       =   1
      MultiSelect     =   -1  'True
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      AllowReorder    =   -1  'True
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   12582912
      BackColor       =   12648384
      BorderStyle     =   1
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      NumItems        =   3
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "预约ID"
         Object.Width           =   1940
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "单位名称"
         Object.Width           =   5292
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   2
         Text            =   "体检日期"
         Object.Width           =   1834
      EndProperty
   End
End
Attribute VB_Name = "FrmDWTJBGDC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim arrYYID()

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdExport_Click()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim rstemp As ADODB.Recordset
    Dim rsResult As ADODB.Recordset
    Dim strTempPath As String '
    Dim strTempFile As String '模板文件名
    Dim strSignFile As String '签名图片
    Dim intMBID As Integer
    Dim intCount As Integer '选择的人数
    Dim arrReportFile() As String '每个客户报表存放的文件名
    Dim arrYYID() As String  '存放客户的唯一编号
    Dim strReportPath As String
    Dim intIndex As Integer '数组上限
    Dim i As Integer, j As Integer, K As Integer
    Dim strHeader As String
    Dim strDXPYSX As String
    Dim strXXPYSX As String
    Dim strPrint As String
    Dim strYYID As String
    Dim blnGetResult As Boolean
    Dim strTempTable As String '返回的临时表名
    
    '以下声明用于Word模板
    Dim WordTemps As Word.Application
    Dim docTemps As Word.Document
    Dim bookColls As Word.Bookmarks
    Dim bookColl As Word.Bookmark
    Dim strBookName As String '书签名
    Dim strXMID As String
    Dim m As Integer, n As Integer
    
    '以下声明用于Graph对象
    Dim oShape As Word.InlineShape
    Dim oChart As Object
    Dim strXTitle As String '横坐标轴上标题
    Dim strYTitle As String '纵坐标轴上标题
    Dim strTitle As String '图表标题
    Dim xlType As XlChartType
    Dim blnHaveSeries As Boolean '是否具有系列轴
    
    '以下声明用于Table对象
    Dim oTable As Word.Table
    Dim lngNumRows As Long '表格的行数
    Dim lngNumCols As Long '表格的列数
    Dim lngCurrRow As Long
    Dim lngCurrCol As Long
    
    '男女人数
    Dim intMale As Integer
    Dim intFemale As Integer
    Dim intTotalOfAlreadyCheck As Integer '已体检总人数
    Dim strTemp As String
    Dim intBegin As Integer
    Dim intStop As Integer
    Dim strColTitle As String
    '疾病人数
    Dim intPeople As Integer
    Dim arrIllPeople() As Integer '患病人数
    Dim arrDMValue() As String  '疾病名称
    '
    Dim strHealthName() As String
    
    Me.MousePointer = vbHourglass
    
    '是否有模板
    If Me.lvwMB.ListItems.Count < 1 Then
        MsgBox "当前尚未添加任何模板，无法执行按模板导出报表！" & vbCrLf _
                & "请到“系统设置”->“报表模板维护”里面添加！如果您看不到这些菜单，请与系统管理员联系！", vbInformation, "提示"
        GoTo ExitLab
    End If
    
    '是否选择了模板
    If Me.lvwMB.SelectedItem Is Nothing Then
        MsgBox "请在右侧的列表里面选择一个模板！", vbInformation, "提示"
        GoTo ExitLab
    End If
    
    '是否有客户
    If Me.LvwDWei.ListItems.Count < 1 Then
        MsgBox "当前没有需要导出报表的团体！", vbInformation, "提示"
        GoTo ExitLab
    End If
    
    '是否选择了客户
    If Me.LvwDWei.SelectedItem Is Nothing Then
        MsgBox "请选择要导出报表的团体！", vbInformation, "提示"
        GoTo ExitLab
    End If
    
    If chkDefault.Value = 1 Then
        strReportPath = BrowseForFolder(Me.hwnd, "请选择导出报表的存放路径")