addexcel1.frm

用microsoft vb6.0写的上班考勤系统！

VERSION 5.00
Begin VB.Form AddExcel 
   Caption         =   "加入EXCEL"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command3 
      Caption         =   "Command3"
      Height          =   495
      Left            =   2400
      TabIndex        =   4
      Top             =   120
      Visible         =   0   'False
      Width           =   1095
   End
   Begin VB.CommandButton Command2 
      Caption         =   "结束"
      Height          =   495
      Left            =   3360
      TabIndex        =   3
      Top             =   2520
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Height          =   495
      Left            =   2160
      TabIndex        =   2
      Top             =   2520
      Width           =   975
   End
   Begin VB.Frame Frame1 
      Caption         =   "请选择要打印的月份"
      ForeColor       =   &H00FF0000&
      Height          =   1335
      Left            =   240
      TabIndex        =   0
      Top             =   720
      Width           =   3735
      Begin VB.ComboBox SelMonth 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   15.75
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000007&
         Height          =   435
         Left            =   600
         TabIndex        =   1
         Text            =   "01"
         Top             =   480
         Width           =   2655
      End
   End
End
Attribute VB_Name = "AddExcel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim VBExcel As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim Rst As New ADODB.Recordset
Dim Cnn As New ADODB.Connection
Dim Xh, AA, BB, CC, D1, D2, EE
Dim X As Integer
Dim Ming, Ri, Shi1, Shi, NameNum
Dim OneFinish, GroupFinish As Boolean

Private Sub Command1_Click()
  NameNum = 0
  
  Set Rst = New ADODB.Recordset
  Rst.Open "select xingming from Cardinfo where bumen='雪肌丽' order by gonghao", Cnn, adOpenStatic, adLockReadOnly, adCmdText
  Set VBExcel = CreateObject("excel.application")
  VBExcel.Visible = True
  Set xlBook = VBExcel.Workbooks.Open("C:\Documents and Settings\Administrator\My Documents\book2")
  Set xlSheet = xlBook.Worksheets("考勤登记表")
  xlSheet.Activate
  xlSheet.Cells(1, 3).Value = "雪肌丽" & Year(Date) & "年" & Month(Date) & "月" & "考勤登记表"
  Xh = xlSheet.Cells(10, 1).Value
  Row = 3
  Col = -1
  
  Do While Not Rst.EOF
      Row = Row
      Col = Col + 3
      If Col = 16 Then
         Row = Row + 33
         Col = 2
      End If
      xlSheet.Cells(Row, Col).Value = Rst("xingming")
      Rst.MoveNext
      NameNum = NameNum + 1
      Col = Col - 1
  Loop
  
  
  YiHang
  'Rst.Close
 
  'Rst.Open ("select * from dangtiandaka where xingming='" + Ming + "'and riqi='" + Ri + "'  in (select sbshijian,xbshijian from dangtiandaka where riqi between '" + CC + "' and '" + BB + "'order by gonghao,riqi), Cnn, adOpenKeyset, adLockOptimistic, adCmdText")
   '每人每月的打卡情况。
  
     
     
     'AA = xlSheet.Cells(Row, 1).Value
     
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Command3_Click()
Set RstShuju = New ADODB.Recordset
RstShuju.Open "select * from dangtiandaka", Cnn, adOpenStatic, adLockBatchOptimistic, adCmdText

  i = 20020401
Do Until RstShuju.Fields(3) = "20020430"
    RstShuju.AddNew
    RstShuju.Fields(0) = "梁振国"
    RstShuju.Fields(3) = i
    RstShuju.Fields(4) = "08:00:52"
    RstShuju.Fields(6) = "18:00:52"
    i = i + 1
    RstShuju.UpdateBatch
Loop
End Sub
Private Sub YiHang()
Dim Nian
  OneFinish = False
  GroupFinish = False
  Nian = Year(Date)
  X = 0
  AA = SelMonth.Text
  D1 = "01"
  D2 = "31"
  BB = Nian & AA & D1
  CC = Nian & AA & D2
Do Until X = NameNum
  
      If OneFinish = False Then
        Row = 3 '7纵
        Col = 2 + 3 * X 'B横
      Else
        Row = Row - 31
        Col = Col + 2
      End If
      
      If X = 7 Then
        Row = Row + 33
        Col = Col - 14
        GroupFinish = True
    'Do Until X = 7
      End If
  'If xlSheet.Cells(7, 2).Value <> "" Then
  '  Col = Col + 3
  'Else
    
      Ming = xlSheet.Cells(Row, Col).Value
      Do Until xlSheet.Cells(Row, 1).Value = 31
             Ri = Nian & AA & xlSheet.Cells(Row + 1, 1).Value
         
             Set Rst = New ADODB.Recordset
             Rst.Open "select sbshijian,xbshijian from dangtiandaka where   xingming='" + Ming + "'and riqi='" + Ri + "'order by riqi", Cnn, adOpenKeyset, adLockOptimistic, adCmdText
             If Not Rst.EOF Then
               'Exit Sub
             'Else
                Shi = Format(Rst("sbshijian"), "hh:mm")
                Shi1 = Format(Rst("xbshijian"), "hh:mm")
                Row = Row + 1
                xlSheet.Cells(Row, Col).Value = Shi  'CStr(Mid(Rst("sbshijian"), 1, 5)) 'Str(Rst("sbshijian").Value)
                Col = Col + 1
                xlSheet.Cells(Row, Col) = Shi1
                Rst.MoveNext
                'Row = Row + 1
                Col = Col - 1
             Else
                Row = Row + 1
                
             End If
             
       Loop
       OneFinish = True
       X = X + 1
    'End If
    'Loop
Loop
End Sub
Private Sub YiYe()
'Do Until Row = 17
     
     'YiHang
     'Row = Row + 3
'Loop
End Sub
Private Sub Form_Load() 'Col横，Row 纵
  Cnn.Open "kaoqin", "andy", "1234"
  Set Rst = New ADODB.Recordset
  Rst.Open "select * from selmonth order by selmonth", Cnn, adOpenKeyset, adLockOptimistic, adCmdText
  Do While Not Rst.EOF
    SelMonth.AddItem Rst.Fields(0)
    Rst.MoveNext
  Loop
End Sub