📄 addexcelwy.frm
字号:
VERSION 5.00
Begin VB.Form AddExcelWY
Caption = "打印管理处打卡情况"
ClientHeight = 4980
ClientLeft = 60
ClientTop = 345
ClientWidth = 4800
LinkTopic = "Form3"
ScaleHeight = 4980
ScaleWidth = 4800
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame1
Caption = "请选择要打印的月份"
ForeColor = &H00FF0000&
Height = 1335
Left = 360
TabIndex = 4
Top = 1800
Width = 3735
Begin VB.ComboBox SelMonth
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000007&
Height = 435
ItemData = "AddExcelWY.frx":0000
Left = 600
List = "AddExcelWY.frx":0028
TabIndex = 5
Top = 480
Width = 2655
End
End
Begin VB.CommandButton Command1
Caption = "确定"
Height = 495
Left = 2040
TabIndex = 3
Top = 3840
Width = 975
End
Begin VB.CommandButton Command2
Caption = "结束"
Height = 495
Left = 3240
TabIndex = 2
Top = 3840
Width = 975
End
Begin VB.Frame Frame2
Caption = "请选择要打印的部门"
ForeColor = &H00FF0000&
Height = 1335
Left = 360
TabIndex = 0
Top = 240
Width = 3735
Begin VB.ComboBox Combo1
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000007&
Height = 435
ItemData = "AddExcelWY.frx":005C
Left = 600
List = "AddExcelWY.frx":006C
TabIndex = 1
Top = 480
Width = 2655
End
End
End
Attribute VB_Name = "AddExcelWY"
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, Shi3, Shi4
Dim OneFinish, GroupFinish As Boolean
Private Sub CheYeBan()
End Sub
Private Sub Command1_Click()
Dim BuMenName, SelYue
NameNum = 0
BuMenName = Trim(Combo1.Text)
SelYue = Trim(SelMonth.Text)
Set Rst = New ADODB.Recordset
Rst.Open "select xingming from Cardinfo where jiwei='" + BuMenName + "' order by gonghao ", Cnn, adOpenStatic, adLockReadOnly, adCmdText
Set VBExcel = CreateObject("excel.application")
VBExcel.Visible = True
Set xlBook = VBExcel.Workbooks.Open("C:\my documents\book2")
Set xlSheet = xlBook.Worksheets("考勤登记表")
xlSheet.Activate
xlSheet.Cells(1, 3).Value = BuMenName & Year(Date) & "年" & SelYue & "月" & "考勤登记表"
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
If BuMenName = "电工" Then
YiHang
Exit Sub
End If
If BuMenName = "会所" Then
Huisuo
End If
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 Huisuo()
YiHang
End Sub
Private Sub FourTimeCard()
Set Rst = New ADODB.Recordset
Rst.Open "select kaoqinshuju"
End Sub
Private Sub YiHang()
Dim Nian, T
OneFinish = False
GroupFinish = 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 + 2
End If
If X = 7 * T Then
Row = Row + 33
Col = Col - 14
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
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 * from kaoqishuju where xingming='" + Ming + "'and riqi='" + Ri + "' order by riqi,shijian", Cnn, adOpenKeyset, adLockOptimistic, adCmdText
If Not Rst.EOF Then
'Exit Sub
'Else
If (Rst!Banhao <> "1008" Or Rst!Banhao <> "1000" Or Rst!Banhao <> "1006") Then
If Rst.RecordCount = 2 Then
Shi = Format(Rst("shijian"), "hh:mm")
Rst.MoveNext
Shi1 = Format(Rst("shijian"), "hh:mm")
If Left(Shi, 2) = "23" Or Left(Shi, 2) = "00" Then
Rst.MovePrevious
If Left(Rst!Shijian, 2) = "15" Or Left(Rst!Shijian, 2) = "16" Then
Col = Col + 1
xlSheet.Cells(Row, Col).Value = Shi
Col = Col - 1
End If
End If
Row = Row + 1
If Left(Shi, 2) = Left(Shi1, 2) Then
xlSheet.Cells(Row, Col).Value = Shi1 'CStr(Mid(Rst("sbshijian"), 1, 5)) 'Str(Rst("sbshijian").Value)
Else
xlSheet.Cells(Row, Col).Value = Shi
End If
Col = Col + 1
If Left(Shi, 2) = Left(Shi1, 2) Then
xlSheet.Cells(Row, Col) = ""
Else
xlSheet.Cells(Row, Col) = Shi1
End If
'Rst.MoveNext
'Row = Row + 1
Col = Col - 1
End If
If Rst.RecordCount >= 3 Then
Shi = Format(Rst("shijian"), "hh:mm")
Rst.MoveNext
Shi1 = Format(Rst("shijian"), "hh:mm")
Rst.MoveNext
Shi3 = Format(Rst("shijian"), "hh:mm")
Row = Row + 1
If Left(Shi, 2) = Left(Shi1, 2) Then
xlSheet.Cells(Row, Col).Value = Shi1 'CStr(Mid(Rst("sbshijian"), 1, 5)) 'Str(Rst("sbshijian").Value)
Else
xlSheet.Cells(Row, Col).Value = Shi
End If
Col = Col + 1
If Left(Shi1, 2) = Left(Shi3, 2) Then
xlSheet.Cells(Row, Col) = Shi3
Else
xlSheet.Cells(Row, Col) = Shi1
End If
Rst.MoveNext
'Row = Row + 1
Col = Col - 1
End If
If Rst.RecordCount = 1 Then
'Shi = IIf(IsNull(Rst("shijian")), "", Format(Rst("shijian")), "hh:mm")
'XingMing(0).Text = IIf(IsNull(RstShuju.Fields(0)), "", Trim(RstShuju.Fields(0)))
Shi = Format(Rst("shijian"), "hh:mm")
Set Rst = New ADODB.Recordset
Rst.Open "select * from dangtiandaka where xingming='" + Ming + "' and riqi='" + Ri + "'", Cnn, adOpenStatic, adLockBatchOptimistic, adCmdText
If Not Rst.EOF Then
If Shi = Format(Rst!sbshijian, "hh:mm") Then
Row = Row + 1
xlSheet.Cells(Row, Col).Value = Shi
Col = Col + 1
Col = Col - 1
Row = Row - 1
End If
If Shi = Format(Rst!xbshijian, "hh:mm") Then
Row = Row + 1
Col = Col + 1
xlSheet.Cells(Row, Col) = Shi
Row = Row - 1
Col = Col - 1
End If
If Shi = Format(Rst!sbshijian1, "hh:mm") Then
Row = Row + 1
xlSheet.Cells(Row, Col).Value = Shi
Col = Col + 1
Col = Col - 1
Row = Row - 1
End If
If Shi = Format(Rst!xbshijian1, "hh:mm") Then
Row = Row + 1
Col = Col + 1
xlSheet.Cells(Row, Col) = Shi
Row = Row - 1
Col = Col - 1
End If
Else
Row = Row + 1
xlSheet.Cells(Row, Col) = Shi
Col = Col + 1
Col = Col - 1
Row = Row - 1
End If
Row = Row + 1
End If
'Row = Row + 1
'Col = Col + 1
'Row = Row - 1
'Col = Col - 1
End If
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 "kqwy", "sa", ""
'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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -