?? frmoutput.frm
字號(hào):
VERSION 5.00
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form frmOutput
BorderStyle = 3 'Fixed Dialog
Caption = "輸出"
ClientHeight = 3945
ClientLeft = 45
ClientTop = 330
ClientWidth = 6270
BeginProperty Font
Name = "宋體"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmOutput.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3945
ScaleWidth = 6270
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin Manage.xpcmdButton cmdCancel
Cancel = -1 'True
Height = 350
Left = 5100
TabIndex = 8
Top = 3540
Width = 1095
_extentx = 1931
_extenty = 609
font = "frmOutput.frx":000C
caption = "關(guān)閉(&C)"
forecolor = -2147483630
End
Begin Manage.xpcmdButton cmdOut
Default = -1 'True
Height = 350
Left = 3900
TabIndex = 7
Top = 3540
Width = 1095
_extentx = 1931
_extenty = 609
font = "frmOutput.frx":0030
caption = "輸出(&O)"
forecolor = -2147483630
End
Begin TabDlg.SSTab stbOut
Height = 3375
Left = 60
TabIndex = 0
Top = 60
Width = 6135
_ExtentX = 10821
_ExtentY = 5953
_Version = 393216
Style = 1
Tabs = 1
TabsPerRow = 1
TabHeight = 520
TabCaption(0) = "Excel 輸出"
TabPicture(0) = "frmOutput.frx":0054
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "lblCount"
Tab(0).Control(0).Enabled= 0 'False
Tab(0).Control(1)= "lblInfo"
Tab(0).Control(1).Enabled= 0 'False
Tab(0).Control(2)= "Line(1)"
Tab(0).Control(2).Enabled= 0 'False
Tab(0).Control(3)= "Line(0)"
Tab(0).Control(3).Enabled= 0 'False
Tab(0).Control(4)= "litName"
Tab(0).Control(4).Enabled= 0 'False
Tab(0).Control(5)= "proBar"
Tab(0).Control(5).Enabled= 0 'False
Tab(0).Control(6)= "cmdselect(0)"
Tab(0).Control(6).Enabled= 0 'False
Tab(0).Control(7)= "cmdselect(1)"
Tab(0).Control(7).Enabled= 0 'False
Tab(0).ControlCount= 8
Begin Manage.xpcmdButton cmdselect
Height = 350
Index = 1
Left = 4800
TabIndex = 6
Top = 1980
Width = 1095
_extentx = 1931
_extenty = 609
font = "frmOutput.frx":0070
caption = "都不選"
forecolor = -2147483630
End
Begin Manage.xpcmdButton cmdselect
Height = 350
Index = 0
Left = 3600
TabIndex = 5
Top = 1980
Width = 1095
_extentx = 1931
_extenty = 609
font = "frmOutput.frx":0094
caption = "全部選中"
forecolor = -2147483630
End
Begin Manage.Xp_ProgressBar proBar
Height = 255
Left = 2520
TabIndex = 4
Top = 2880
Visible = 0 'False
Width = 3375
_extentx = 5953
_extenty = 450
End
Begin VB.ListBox litName
Height = 2790
Left = 120
Style = 1 'Checkbox
TabIndex = 1
Top = 420
Width = 2175
End
Begin VB.Line Line
BorderColor = &H00808080&
Index = 0
X1 = 2520
X2 = 5880
Y1 = 2400
Y2 = 2400
End
Begin VB.Line Line
BorderColor = &H00FFFFFF&
Index = 1
X1 = 2520
X2 = 5880
Y1 = 2415
Y2 = 2415
End
Begin VB.Label lblInfo
BackStyle = 0 'Transparent
Caption = " 將員工資料輸出到Excel文件中,默認(rèn)輸出為[員工編號(hào),姓名,隸屬部門(mén)],可選擇添加輸出的內(nèi)容,如果系統(tǒng)未安裝Excel,此功能將不可用! "
Height = 735
Left = 2520
TabIndex = 3
Top = 720
Width = 3330
End
Begin VB.Label lblCount
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 180
Left = 2520
TabIndex = 2
Top = 2580
Width = 90
End
End
End
Attribute VB_Name = "frmOutput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim blnTF As Boolean
Private Sub cmdCancel_Click()
If blnTF = True Then
blnTF = False
Else
Unload Me
End If
End Sub
Private Sub cmdOut_Click() 'Excel輸出
Dim intSave As Integer
Dim intTemp As Integer
Dim strSelect As String
On Error GoTo errNext
With adoMainLink
If .State = adStateOpen Then .Close
cmdOut.Enabled = False
With frmInfo.cdgMain
.Filename = ""
.DialogTitle = "另存為Excel文檔"
.Filter = "Excel文件(*.xls)|*.xls|"
.ShowSave
strSelect = Trim(.Filename)
If Len(strSelect) = 0 Then GoTo ExitClear
If Dir(strSelect) <> "" Then
If MsgBox("此文件已存在,確認(rèn)要覆蓋嗎?(Y/N)", vbInformation + vbYesNo) = vbYes Then
Kill strSelect
Else
GoTo ExitClear
End If
End If
End With
strSelect = "員工編號(hào),隸屬部門(mén),姓名"
intTemp = litName.ListCount
For intCount = 1 To intTemp
If litName.Selected(intCount - 1) = True Then
'strSelect = IIf(litName.List(intCount - 1) Like "*(*)*", strSelect & ",[" & litName.List(intCount - 1) & "]", strSelect & "," & litName.List(intCount - 1))
strSelect = strSelect & "," & litName.List(intCount - 1)
End If
Next
Dim objExcel As Object
lblCount.Caption = " 創(chuàng)建Excel對(duì)象..."
blnTF = True
Set objExcel = CreateObject("Excel.Sheet.8")
.Open "select " & strSelect & " from v員工詳細(xì)資料 order by 隸屬部門(mén),員工編號(hào)", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
If .EOF = False Then
proBar.Value = 0
proBar.Visible = True
lblCount.Caption = " 將字段名添加到Excel表格中..."
intTemp = .Fields.Count - 1
For intCount = 0 To intTemp
objExcel.Worksheets(1).cells(1, intCount + 1).Value = adoMainLink(intCount).Name
Next
.MoveLast
proBar.Max = .RecordCount
.MoveFirst
intCount = 2
Do Until .EOF ' 在記錄中循環(huán)
lblCount.Caption = "寫(xiě)入記錄中: " & proBar.Value & "/" & proBar.Max
For intSave = 0 To intTemp ' 加每個(gè)字段的值加到工作表中
objExcel.Worksheets(1).cells(intCount, intSave + 1).Value = .Fields(intSave).Value
Next
DoEvents
If blnTF = False Then
If MsgBox("確認(rèn)要中止Excel輸出嗎?", vbOKCancel) = vbOK Then
objExcel.Application.Quit
GoTo ExitClear
End If
blnTF = True
End If
.MoveNext
intCount = intCount + 1
proBar.Value = proBar.Value + 1
Loop
lblCount.Caption = " 保存文件..." ' 保存工作表
objExcel.SaveAs frmInfo.cdgMain.Filename
objExcel.Application.Quit
Else
MsgBox "未找到記錄,保存失敗!", vbCritical, App.Title
objExcel.Application.Quit
GoTo ExitClear
End If
End With
GoTo ExitClear
MsgBox "文件輸出成功!", vbInformation, App.Title
frmInfo.cdgMain.Filename = ""
errNext:
Call ErrMsg(Err.Number, Err.Description)
ExitClear:
blnTF = False
cmdOut.Enabled = True
lblCount.Caption = ""
proBar.Visible = False
End Sub
Private Sub cmdselect_Click(Index As Integer)
Dim blnYN As Boolean
litName.Visible = False
blnYN = Index
For intCount = 1 To litName.ListCount
If litName.Selected(intCount - 1) = blnYN Then litName.Selected(intCount - 1) = Not blnYN
Next
litName.ListIndex = 0
litName.Visible = True
End Sub
Private Sub Form_Load()
blnTF = False
On Error Resume Next
With adoMainLink
If .State = adStateOpen Then .Close
.Open "select * from v員工詳細(xì)資料", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
For intCount = 3 To .Fields.Count
litName.AddItem .Fields(intCount).Name, intCount - 3
Next
End With
End Sub
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -