?? frmexport.frm
字號:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmexport
Caption = "導出記錄"
ClientHeight = 4620
ClientLeft = 60
ClientTop = 450
ClientWidth = 6345
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4620
ScaleWidth = 6345
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdcancel
Caption = "取 消"
BeginProperty Font
Name = "楷體_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3720
TabIndex = 6
Top = 3480
Width = 1215
End
Begin VB.CommandButton cmdok
Caption = "導 出"
BeginProperty Font
Name = "楷體_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1440
TabIndex = 5
Top = 3480
Width = 1215
End
Begin VB.CommandButton cmdpath
Caption = "..."
BeginProperty Font
Name = "宋體"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 5160
TabIndex = 4
Top = 2160
Width = 735
End
Begin VB.TextBox textfilepath
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2520
TabIndex = 3
Top = 2160
Width = 2295
End
Begin VB.ComboBox commonth
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 2520
TabIndex = 2
Top = 1080
Width = 2295
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 5160
Top = 1080
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Label Label2
Caption = "保存為"
BeginProperty Font
Name = "楷體_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 960
TabIndex = 1
Top = 2160
Width = 1215
End
Begin VB.Label Label1
Caption = "月 份"
BeginProperty Font
Name = "楷體_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 960
TabIndex = 0
Top = 1080
Width = 1215
End
End
Attribute VB_Name = "frmexport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public strfilepath As String
Private Sub cmdcancel_Click()
Unload Me
Exit Sub
End Sub
Private Sub cmdok_Click()
Dim i As Integer
Dim rsobj As New ADODB.Recordset
Dim sql As String
Dim firstday As String
Dim days As Integer
Dim lastday As String
Dim oexcel As Object
Dim obook As Object
Dim osheet As Object
On Error GoTo command1_click_error
If Me.textfilepath = "" Then
MsgBox "請選擇文件保存位置", vbOKOnly + vbExclamation, "提示"
Else
firstday = Year(Date) & "-" & Me.commonth.Text & "-1"
days = DateDiff("d", Year(Date) & "-" & Me.commonth.Text & "-1", _
Year(Date) & "-" & Me.commonth.Text + 1 & "-1")
lastday = Year(Date) & "-" & Me.commonth.Text & "-" & days
sql = "select * from salarystatistics where yearmonth between #"
sql = sql & firstday & "# and #" & lastday & "#"
Set rsobj = getrs(sql, "salary")
If rsobj.EOF = False Then '判斷是否有統計記錄
Set oexcel = CreateObject("Excel.application")
Set obook = oexcel.Workbooks.add
Set osheet = obook.Worksheets(1)
Set osheet = oexcel.Application.Workbooks(1).Worksheets("sheet1")
osheet.Range("a1:l1").Select '設置單元格
With oexcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
oexcel.Selection.Merge '設置標題
osheet.Range("a1:l1").Select
oexcel.ActiveCell.FormulaR1C1 = Format(Date, "yyyy" _
) & "年" & Me.commonth.Text & "月工資統計記錄"
With oexcel.ActiveCell.Characters(Start:=1, Length:=26).Font
.Name = "宋體"
.FontStyle = "加粗"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Set osheet = oexcel.Application.Workbooks(1).Worksheets("sheet1") '設置表格
osheet.Cells(2, 1).Value = "編號"
osheet.Cells(2, 2).Value = "姓名"
osheet.Cells(2, 3).Value = "日期"
osheet.Cells(2, 4).Value = "基本工資"
osheet.Cells(2, 5).Value = "獎金"
osheet.Cells(2, 6).Value = "福利"
osheet.Cells(2, 7).Value = "津貼"
osheet.Cells(2, 8).Value = "扣發"
osheet.Cells(2, 9).Value = "加班費"
osheet.Cells(2, 10).Value = "出差費"
osheet.Cells(2, 11).Value = "其他"
osheet.Cells(2, 12).Value = "總計"
osheet.Columns("A:A").ColumnWidth = 8 '設置表格寬度
osheet.Columns("B:B").ColumnWidth = 6
osheet.Columns("C:C").ColumnWidth = 8
osheet.Columns("D:D").ColumnWidth = 8
osheet.Columns("E:E").ColumnWidth = 4
osheet.Columns("F:F").ColumnWidth = 4
osheet.Columns("G:G").ColumnWidth = 4
osheet.Columns("H:H").ColumnWidth = 4
osheet.Columns("I:I").ColumnWidth = 6
osheet.Columns("J:J").ColumnWidth = 6
osheet.Columns("K:K").ColumnWidth = 4
osheet.Columns("L:L").ColumnWidth = 6
rsobj.MoveFirst
For i = 3 To rsobj.RecordCount + 2 '顯示信息
osheet.Cells(i, 1).Value = rsobj(1)
osheet.Cells(i, 2).Value = rsobj(2)
osheet.Cells(i, 3).Value = Format(rsobj(3), "yyyy-mm")
osheet.Cells(i, 4).Value = rsobj(4)
osheet.Cells(i, 5).Value = rsobj(5)
osheet.Cells(i, 6).Value = rsobj(6)
osheet.Cells(i, 7).Value = rsobj(7)
osheet.Cells(i, 8).Value = Format(rsobj(8) + rsobj(9) + rsobj(10), "####")
osheet.Cells(i, 9).Value = rsobj(11)
osheet.Cells(i, 10).Value = rsobj(12)
osheet.Cells(i, 11).Value = rsobj(13)
osheet.Cells(i, 12).Value = Format(rsobj(14), "####")
rsobj.MoveNext
Next i
With osheet '設置邊框
.Range(.Cells(1, 1), .Cells(rsobj.RecordCount + 2, 12)).Borders.LineStyle = xlContinuous
End With
obook.SaveAs strfilepath '保存文件
If MsgBox("是否轉到導出的Excel文件？", vbOKCancel) = vbOK Then
Unload Me
oexcel.Visible = True
Else
MsgBox "已經成功導出記錄！", vbOKOnly + vbExclamation, "提示！"
Unload Me
End If
Exit Sub
Else
MsgBox "數據庫中沒有選擇月份記錄！", vbOKOnly + vbExclamation, "提示！"
Me.ZOrder 0
End If
End If
command1_click_error:
Exit Sub
End Sub
Private Sub cmdpath_Click()
CommonDialog1.CancelError = True
On Error GoTo errhandler
CommonDialog1.Flags = cdlOFNHideReadOnly
CommonDialog1.Filter = "All Files (*.*)|*.*|Excel Files" & _
"(*.xls)|*.xls"
CommonDialog1.FilterIndex = 2
CommonDialog1.ShowSave
Me.textfilepath = CommonDialog1.FileName
strfilepath = CommonDialog1.FileName
Exit Sub
errhandler:
Exit Sub
End Sub
Private Sub Form_Load()
Dim i As Integer
For i = 1 To 12
Me.commonth.AddItem i
Next i
Me.commonth.ListIndex = 0
Me.textfilepath = ""
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -