frmcheck.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
      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            =   "04"
         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

Private Sub Command1_Click()
  'xlSheet.Cells(2, 4).Value = Year(Date) & "年" & Month(Date) & "月" & "考勤登记表"
  
  Set Rst = New ADODB.Recordset
  Rst.Open "select xingming from Cardinfo 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
  Xh = xlSheet.Cells(10, 1).Value
  Row = 7
  Col = -1
  
  Do While Not Rst.EOF
      Row = Row
      Col = Col + 3
      If Col = 17 Then
         Row = Row + 108
         Col = 2
      End If
      xlSheet.Cells(Row, Col).Value = Rst("xingming")
      Rst.MoveNext
  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()
  X = 0
  Do Until X = 5
    AA = SelMonth.Text
    D1 = "01"
    D2 = "31"
  
    
    BB = "2002" & AA & D1
    CC = "2002" & AA & D2
    Row = 7 '7纵
    Col = 2 + 3 * X 'B横
  'If xlSheet.Cells(7, 2).Value <> "" Then
  '  Col = Col + 3
  'Else
    Ming = xlSheet.Cells(Row, Col).Value
    Do Until xlSheet.Cells(Row + 4, 1).Value = 31
           Ri = "2002" & AA & xlSheet.Cells(Row + 4, 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 Rst.EOF Then
             Exit Sub
           Else
              Shi = Rst("sbshijian")
              Shi1 = Format(Rst("xbshijian"), "hh:mm")
              Row = Row + 4
              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
           End If
     Loop
     X = X + 1
  'End If
  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