📄 frmexport.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form frmExport
Caption = "导出记录"
ClientHeight = 3855
ClientLeft = 60
ClientTop = 345
ClientWidth = 5850
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3855
ScaleWidth = 5850
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdPath
Caption = "..."
Height = 375
Left = 4320
TabIndex = 6
Top = 1560
Width = 495
End
Begin VB.CommandButton cmdCancel
Caption = "取 消"
Height = 495
Left = 3480
TabIndex = 5
Top = 2640
Width = 1335
End
Begin VB.CommandButton cmdOK
Caption = "导 出"
Height = 495
Left = 1200
TabIndex = 4
Top = 2640
Width = 1335
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 4440
Top = 720
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.TextBox textFilePath
BeginProperty Font
Name = "楷体_GB2312"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2280
TabIndex = 3
Top = 1560
Width = 1935
End
Begin VB.ComboBox comMonth
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 2280
TabIndex = 1
Top = 840
Width = 1935
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 = 375
Left = 1200
TabIndex = 2
Top = 1560
Width = 855
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 = 375
Left = 1200
TabIndex = 0
Top = 840
Width = 855
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 + -