如何为 Excel 工作表函数创建 Visual Basic 自动化加载项

[code]Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

Dim oApp As Object  'The Excel Application object

Private Sub AddinInstance_OnAddInsUpdate(custom() As Variant)
Exit Sub
End Sub

Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
Set oApp = Application
End Sub

Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
Set oApp = Nothing
End Sub

Private Sub AddinInstance_OnStartupComplete(custom() As Variant)
Exit Sub
End Sub

Public Function TickCount() As Long
'----------------------------------------------------------------------
'** A volatile function that is called each time the sheet is calculated.
'   Call with =TICKCOUNT().
'----------------------------------------------------------------------
oApp.Volatile
TickCount = GetTickCount
End Function

Public Function Add1(Num1 As Variant, Num2 As Variant) As Variant
'----------------------------------------------------------------------
'** A function with two required arguments.
'   Can be called with formulas such as =Add1(1,3) or =Add1(A1,A2).
'----------------------------------------------------------------------
On Error Resume Next
Add1 = "The sum of " & Num1 & " and " & Num2 & " is " & _
CDbl(Num1) + CDbl(Num2)
If Err <> 0 Then Add1 = CVErr(2036)  'xlErrNum = 2036
End Function

Public Function Add2(Num1 As Variant, Num2 As Variant, Optional Num3 As Variant) As Variant
'----------------------------------------------------------------------
'** A function with two required arguments and a third optional argument.
'   Can be called with formulas such as =Add2(1,2), =Add2(A1,A2,A3).
'----------------------------------------------------------------------
Dim Sum As Double, sMsg As String
On Error GoTo Handler
Sum = CDbl(Num1) + CDbl(Num2)
If IsMissing(Num3) Then
sMsg = "The sum of " & Num1 & " and " & Num2 & " is "
Else
Sum = Sum + CDbl(Num3)
sMsg = "The sum of " & Num1 & ", " & Num2 & " and " & Num3 & " is "
End If
Add2 = sMsg & Sum
Exit Function
Handler:
Add2 = CVErr(2036)  'xlErrNum = 2036
End Function

Public Function Add3(ParamArray Nums()) As Variant
'----------------------------------------------------------------------
'** Demonstrates a function with a variable number of arguments.
'   Can be called with formulas like =Add3(1), =Add3(1,2,3,4),
'   or =Add3(A1,A2).
'----------------------------------------------------------------------
Dim Sum As Double, i As Integer
On Error GoTo Handler
For i = 0 To UBound(Nums)
Sum = Sum + CDbl(Nums(i))
Next
Add3 = "The sum is " & Sum
Exit Function
Handler:
Add3 = CVErr(2036)  'xlErrNum = 2036
End Function

Public Function ReturnArray(nRows As Long, nCols As Long) As Variant
'----------------------------------------------------------------------
'** Demonstrates how to return an array of values (for use in Excel
'   "array formulas").
'   Can be called with a formula such as =ReturnArray(1,3).
'----------------------------------------------------------------------
On Error GoTo Handler
ReDim a(0 To nRows, 0 To nCols) As Variant
Dim r As Long, c As Long
For r = 0 To nRows - 1
For c = 0 To nCols - 1
a(r, c) = "r" & r + 1 & "c" & c + 1
Next c
Next r
ReturnArray = a
Exit Function
Handler:
ReturnArray = CVErr(2015)  'xlErrValue = 2015
End Function

Public Function GetArray(Nums As Variant) As Variant
'----------------------------------------------------------------------
'** Demonstrates how to use an array(or range of multiple cells) as
'   a function argument.
'   Can be called with formulas such as =GetArray(A1:B5), GetArray(A1),
'   or GetArray({1,2,3;4,5,6}).
'----------------------------------------------------------------------
Dim Sum As Double, v As Variant
On Error GoTo Handler
If IsArray(Nums) Then
For Each v In Nums
Sum = Sum + CDbl(v)
Next
Else
Sum = CDbl(Nums)
End If
GetArray = "The sum is " & Sum
Exit Function
Handler:
GetArray = CVErr(2036)  'xlErrNum = 2036
End Function