Public Sub 考勤() 生成DLL

Public Sub 考勤()

Dim xlApp As Object

On Error Resume Next

Set xlApp = GetObject(, "Excel.Application")

'Dim rng As xlApp.range 会产生用户定义类型错误，直接引用range即可。

If Not xlApp.range("c1").Value Like "有效签到" Then '如无指定列，插入空列

xlApp.Columns("C:C").Select

    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    xlApp.Columns("C:H").Select

    Selection.NumberFormatLocal = "h:mm;@"

'     With Selection

'         .HorizontalAlignment = xlCenter

'         .VerticalAlignment = xlCenter

'         .WrapText = False

'         .Orientation = 0

'         .AddIndent = False

'         .IndentLevel = 0

'         .ShrinkToFit = False

'         .ReadingOrder = xlContext

'         .MergeCells = False

'

'     End With

xlApp.range("c1").Value = "有效签到"

xlApp.range("d1").Value = "签到状态"

xlApp.range("e1").Value = "有效签离"

xlApp.range("f1").Value = "签离状态"

xlApp.range("g1").Value = "工作时长"

xlApp.range("h1").Value = "考勤评测"

End If

For Each rng In Sheet1.xlApp.range("a1:z1") '在首行找到相应的字段所在列值

'If rng = "最早签到时间" Then colu_c = rng.Column

If rng Like "最早签到时间" Then colu_c$ = VBA.Split(rng.Address, "$")(1)

If rng Like "最晚签到时间" Then colu_l$ = VBA.Split(rng.Address, "$")(1)

If rng Like "签到标准" Then colu_cs$ = VBA.Split(rng.Address, "$")(1)

If rng Like "签离标准" Then colu_ls$ = VBA.Split(rng.Address, "$")(1)

If rng Like "出勤状态" Then colu_zk$ = VBA.Split(rng.Address, "$")(1)

Next

'Declare Function kqCopy Lib "c:/windows/kaoqin1.dll" ()

'

'Dim kk As New xlApp.kq365

 

'kq365为VB中类模块名称：输入完New后，敲空格键,直接出现选择列表框，从中选择“kq365”

' kk可任意命名

introw = xlApp.cells(a655536).End(xlUp).Row

'introw = [a655536].End(xlUp).Row

Dim i As Integer

For i = 2 To introw Step 1

tc = xlApp.range(colu_c & i)

tcs = xlApp.range(colu_cs & i)

  tl = xlApp.range(colu_l & i)

  tls = xlApp.range(colu_ls & i)

  zk = xlApp.range(colu_zk & i)

  myarr2 = xlApp.kp365.kq(tcs, tc, tls, tl, zk)

  ' myarr2 = kk.kq(tcs, tc, tls, tl, zk)

  xlApp.range("c" & i).Value = myarr2(0)

  xlApp.range("d" & i).Value = myarr2(1)

  xlApp.range("e" & i).Value = myarr2(2)

  xlApp.range("f" & i).Value = myarr2(3)

  xlApp.range("g" & i).Value = myarr2(4)

  xlApp.range("h" & i).Value = myarr2(5)

  Next

   

   

      xlApp.Columns("C:H").Select

    xlApp.Columns("C:H").EntireColumn.AutoFit

'kq为VB中要执行的模块的名称：输入完kk.后，直接出现选择列表框，从中选择“kq365”

'kq为VB中的过程或函数名称，从列表中选的

  Set kk = Nothing '释放类资源

End Sub

'-----------------------------------------------------

问题集锦：

Q1运行时错误91 对象变量或With块变量未设置

目的：为了宏外观简单，便于移植和调用 我用VB将EXCEL中VBA名为attendance的过程（SUB）封装成attend.dll，其子类attend365。回到EXCEL，我建建一个宏，调用attend.dll,代码如下 Sub a()
Dim aa As attend365
aa.考勤
End Sub> 结果如上图。