📄 addexcel(4).frm
字号:
VERSION 5.00
Begin VB.Form AddFour
Caption = "加入EXCEL(Four)"
ClientHeight = 4905
ClientLeft = 60
ClientTop = 345
ClientWidth = 4380
LinkTopic = "Form3"
ScaleHeight = 4905
ScaleWidth = 4380
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame1
Caption = "请选择要打印的月份"
ForeColor = &H00FF0000&
Height = 1335
Left = 360
TabIndex = 4
Top = 2040
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 = 5
Text = "02"
Top = 480
Width = 2655
End
End
Begin VB.CommandButton Command1
Caption = "确定"
Height = 495
Left = 2040
TabIndex = 3
Top = 4080
Width = 975
End
Begin VB.CommandButton Command2
Caption = "结束"
Height = 495
Left = 3240
TabIndex = 2
Top = 4080
Width = 975
End
Begin VB.Frame Frame2
Caption = "请选择要打印的部门"
ForeColor = &H00FF0000&
Height = 1335
Left = 360
TabIndex = 0
Top = 480
Width = 3735
Begin VB.ComboBox Combo1
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000007&
Height = 435
ItemData = "AddExcel(4).frx":0000
Left = 600
List = "AddExcel(4).frx":000D
TabIndex = 1
Text = "会所"
Top = 480
Width = 2655
End
End
End
Attribute VB_Name = "AddFour"
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 RstY 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, Shi3, Shi4
Dim OneFinish, GroupFinish, AllNothing As Boolean
Dim Row, Col
Dim ShiKuaRi As Boolean
Dim FirGo As Boolean
Dim Yesterday
Dim KSJ
Private Sub Command1_Click()
Dim BuMenName
If SelMonth.Text = "" And Combo1.Text = "" Then Exit Sub
Huisuo
NameNum = 0
BuMenName = Trim(Combo1.Text)
Set Rst = New ADODB.Recordset
'Rst.Open "select xingming from Cardinfo where bumen='" + BuMenName + "'and (banhao='0000' or banhao='0006' or banhao='0008') order by gonghao ", Cnn, adOpenStatic, adLockReadOnly, adCmdText
Rst.Open "select xingming from Cardinfo where bumen='" + BuMenName + "' order by gonghao ", Cnn, adOpenStatic, adLockReadOnly, adCmdText
Set VBExcel = CreateObject("excel.application")
VBExcel.Visible = True
Set xlBook = VBExcel.Workbooks.Open("C:\my documents\book4")
Set xlSheet = xlBook.Worksheets("考勤登记表")
xlSheet.Activate
'xlSheet.Cells(1, 3).Value = BuMenName & 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 = 18 Then
Row = Row + 33
Col = 2
End If
xlSheet.Cells(Row, Col).Value = Rst("xingming")
Rst.MoveNext
NameNum = NameNum + 1
Col = Col + 1
Loop
If BuMenName = "雪肌丽" Then
YiHang
End If
If BuMenName = "会所" Or BuMenName = "西餐厅" Or BuMenName = "筹建处" Then
Huisuo
End If
'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 Huisuo4()
Dim Nian, T, EndTime
Dim i As Index
OneFinish = False
GroupFinish = False
ShiKuaRi = False
FirGo = False
Nian = Year(Date)
X = 0
T = 1
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 + 4
End If
If X = 4 * T Then
Row = Row + 33
Col = Col - 16
GroupFinish = True
T = T + 1
'Do Until X = 7
End If
'If xlSheet.Cells(7, 2).Value <> "" Then
' Col = Col + 3
'Else
Ming = xlSheet.Cells(Row, Col).Value
'Ming = "冯健韵"
Do Until xlSheet.Cells(Row, 1).Value = 31
ShiKuaRi = False
Ri = Nian & AA & xlSheet.Cells(Row + 1, 1).Value
Set Rst = New ADODB.Recordset
Rst.Open "select * from kaoqishuju where xingming='" + Ming + "'and riqi='" + Ri + "' order by riqi,shijian", Cnn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not Rst.EOF
If FirGo = False Then
Row = 4
FirGo = True
End If
If xlSheet.Cells(Row, Col).Value = "" Then
xlSheet.Cells(Row, Col).Value = Format(Rst!Shijian, "hh:mm")
Else
If xlSheet.Cells(Row, Col + 1).Value = "" Then
xlSheet.Cells(Row, Col + 1).Value = Format(Rst!Shijian, "hh:mm")
Else
If xlSheet.Cells(Row, Col + 2).Value = "" Then
xlSheet.Cells(Row, Col + 2).Value = Format(Rst!Shijian, "hh:mm")
Else
If xlSheet.Cells(Row, Col + 3).Value = "" Then
xlSheet.Cells(Row, Col + 3).Value = Format(Rst!Shijian, "hh:mm")
End If
End If
End If
End If
Rst.MoveNext
Col = Col + 1
Loop
Row = Row + 1
Loop
OneFinish = True
X = X + 1
'End If
'Loop
Loop
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Huisuo()
YiHang
End Sub
Private Sub FourTimeCard()
Set Rst = New ADODB.Recordset
Rst.Open "select "
End Sub
Private Sub CheKuaRi()
Dim BiJiaoShijian
Dim YShiJian
If Shi > "23:00" And (Shi < "00:00" And Shi = "00:00") Then
If Not Rst.BOF Then
'Rst.MovePrevious
'BiJiaoShijian = Shi
If Rst.RecordCount = 1 Then
End If
BiJiaoShijian = DateDiff("h", Shi1, Shi) '前时后负
End If
End If
If Rst.RecordCount = 3 And Shi < "00:59" And Shi > "00:00" And Shi = "00:00" Then
Set RstY = New ADODB.Recordset
RstY.Open "select * from kaoqishuju where riqi='" & (Rst!Riqi - 1) & "'order by riqi,shijian", Cnn, adOpenStatic, adLockBatchOptimistic, adCmdText
Rst.MoveLast
YShiJian = Rst!Shijian
BiJiaoShijian = DateDiff("h", Shi, YShiJian)
If BiJiaoShijian > 8 And BiJiaoShijian < 17 Then
xlSheet.Cells(Row - 1, Col + 1).Value = Shi
'Row = Row + 1
Col = Col + 1
ShiKuaRi = True
Exit Sub
End If
End If
If Shi < "01:00" And Shi > "23:59" Then
BiJiaoShijian = DateDiff("h", Shi, Shi1)
If BiJiaoShijian > 11 Then
If xlSheet.Cells(Row, Col).Value = "" Then
xlSheet.Cells(Row, Col).Value = Shi
Else
Col = Col + 1
If xlSheet.Cells(Row, Col).Value = "" Then
xlSheet.Cells(Row, Col).Value = Shi
Row = Row + 1
Else
Col = Col + 1
If xlSheet.Cells(Row, Col).Value = "" Then
xlSheet.Cells(Row, Col).Value = Shi
Row = Row + 1
Else
Col = Col + 1
xlSheet.Cells(Row, Col).Value = Shi
Row = Row + 1
End If
End If
End If
ShiKuaRi = True
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -