📄 frmttmddc.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 frmTTMDDC
BackColor = &H80000018&
BorderStyle = 1 'Fixed Single
Caption = "团体名单导出"
ClientHeight = 7590
ClientLeft = 45
ClientTop = 435
ClientWidth = 10770
Icon = "frmTTMDDC.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7590
ScaleWidth = 10770
StartUpPosition = 2 '屏幕中心
Begin MSComDlg.CommonDialog CommonDialog1
Left = 5145
Top = 3270
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Frame Frame3
BackColor = &H80000018&
Height = 735
Left = 135
TabIndex = 5
Top = 6270
Width = 3690
Begin VB.CheckBox chkPrintImmediate
BackColor = &H80000018&
Caption = "导出后立即打印"
Height = 315
Left = 1710
TabIndex = 9
Top = 270
Width = 1785
End
Begin XPControls.XPCommandButton cmdExportToExcel
Height = 390
Left = 240
TabIndex = 6
Top = 210
Width = 1305
_ExtentX = 2302
_ExtentY = 688
Enabled = 0 'False
Caption = "导出到Excel(T)"
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 Frame2
BackColor = &H80000018&
Caption = "选择单位"
Height = 6045
Left = 150
TabIndex = 2
Top = 135
Width = 3690
Begin VB.CheckBox chkZJOnly
BackColor = &H80000018&
Caption = "仅显示已总检人员"
Height = 285
Left = 120
TabIndex = 7
Top = 5310
Width = 2235
End
Begin VB.TextBox txtName
Height = 285
Left = 120
TabIndex = 4
ToolTipText = "输入单位名称然后回车进行查找"
Top = 5610
Width = 3450
End
Begin MSComctlLib.ListView lvwDWei
Height = 4980
Left = 105
TabIndex = 3
Top = 270
Width = 3480
_ExtentX = 6138
_ExtentY = 8784
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 1
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "单位名称"
Object.Width = 5362
EndProperty
End
End
Begin VB.Frame Frame1
BackColor = &H80000018&
Height = 7320
Left = 3900
TabIndex = 0
Top = 135
Width = 6735
Begin MSComctlLib.ListView lvwPeople
Height = 7020
Left = 105
TabIndex = 1
Top = 180
Width = 6495
_ExtentX = 11456
_ExtentY = 12383
View = 3
LabelEdit = 1
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = 0 'False
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 12
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "序号"
Object.Width = 1129
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "档案号"
Object.Width = 1834
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "姓名"
Object.Width = 1482
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "性别"
Object.Width = 952
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
Text = "年龄"
Object.Width = 952
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 5
Text = "分组编号"
Object.Width = 1834
EndProperty
BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 6
Text = "分组名称"
Object.Width = 2117
EndProperty
BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 7
Text = "家庭电话"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(9) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 8
Text = "办公电话"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(10) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 9
Text = "移动电话"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(11) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 10
Text = "查询码"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(12) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 11
Text = "体检日期"
Object.Width = 2540
EndProperty
End
End
Begin XPControls.XPCommandButton cmdExit
Height = 390
Left = 1200
TabIndex = 8
Top = 7110
Width = 1305
_ExtentX = 2302
_ExtentY = 688
Caption = "退出(E)"
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
Attribute VB_Name = "frmTTMDDC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub chkZJOnly_Click()
If Not (lvwDWei.SelectedItem Is Nothing) Then
LvwDWei_Click
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdExportToExcel_Click()
Dim Status
Dim strSQL As String
Dim rstemp As ADODB.Recordset
Dim strFileName As String
Dim strYYID As String
Dim intCount As Integer
Dim blnPrintImmediate As Boolean
Dim strPeoples As String
Dim blnZJOnly As Boolean
Dim strReturn As String
Dim lngPosition As Long
Me.MousePointer = vbHourglass
'是否有选择
If lvwDWei.SelectedItem Is Nothing Then GoTo ExitLab
'记录预约编号
strYYID = Mid(lvwDWei.SelectedItem.Key, 2)
'是否只显示已总检人员
blnZJOnly = CBool(chkZJOnly.Value)
'是否立即打印
blnPrintImmediate = CBool(chkPrintImmediate.Value)
'获取文件名
strFileName = GetFileName(Me.CommonDialog1, "Microsoft Excel 工作簿（*.xls）|*.xls", _
"另存为", "团体名单_" & lvwDWei.SelectedItem.Text & ".xls", WRITEFILE)
If strFileName = "" Then GoTo ExitLab
On Error GoTo ErrMsg
'创建临时表
strSQL = "CREATE TABLE " & TempTable _
& " ([GUID] bigint primary key,序号 int,档案号 Varchar(20)" _
& ",姓名 Varchar(20),性别 Varchar(2),年龄 Varchar(5),分组 int,分组名称 Varchar(40)" _
& ",家庭电话 Varchar(20),办公电话 Varchar(20),移动电话 Varchar(20)" _
& ",查询码 Varchar(20),体检日期 smalldatetime" _
& ")"
If CreateTable(TempTable, True, strSQL) = False Then GoTo ExitLab
'向临时表写入数据
strSQL = "insert into " & TempTable _
& "(GUID,档案号,姓名,性别,年龄,分组,分组名称,家庭电话,办公电话,移动电话,查询码,体检日期)"
strSQL = strSQL & " select SET_GRXX.GUID,"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -