frmexport.frm

VB版的毕业设计作品

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