科学网EXCEL中写好的函数,可以在WORD中调用吗?

2020-01-15 13:28

我在EXCEL中做过一个编码与名称转换的函数,一般都是在EXCEL文件中使用,作为加载宏无需每次都复制到某个文件中,用起来就象是EXCEL自身的功能一样方便,很好用.

但有些时候,WORD文件中也可能需要这些编码转换的功能，怎么办? 最常用的方法,是先在EXCEL中转换好,再人工复制到WORD中来使用就行了.但这样有点麻烦,操作上还比较容易出错。我就想,EXCEL中的编写的这些代码,在WORD中可以调用吗?

经过一番摸索与实验,发现调用是可以的,需要用到EXCEL来加载文件,再用EXCEL对象来运行这个宏,将结果再返回到WORD环境中就可以了.

举例来说，先新建一个xls文件，在EXCEL的模块中写好如下三个函数,将文件存为"工具函数.xls"

Function MyRand(upLimit%) As Double
MyRand = WorksheetFunction.RandBetween(0, upLimit)

End Function

Function Utrim(str$) As String
Utrim = UCase(Trim(str))

End Function

Function TGDZ(theYear As Integer) As String '将年份转化为天干地支
Dim N As Integer, M1 As Integer, M2 As Integer
Application.Volatile
If theYear = 0 Then
MsgBox "年份不能为0,没有公元0年这一说法,开始即为公元1年"
TGDZ = "年份错误不能为0"
Exit Function
End If
N = theYear - IIf(theYear > 0, 4, 3)
M1 = (N Mod 10) + 10 * IIf((N Mod 10) < 0, 1, 0) + 1
M2 = (N Mod 12) + 12 * IIf((N Mod 12) < 0, 1, 0) + 1
TGDZ = Mid("甲乙丙丁戊已庚辛壬癸", M1, 1) & Mid("子丑寅卯辰已午未申酉戌亥", M2, 1)
End Function

这没有什么特殊的，只要不设置函数为私有就可以调用。

再新建一个WORD文件,新建模块写入以下代码来调用

Sub 调用函数()

'准备调用类的对象，启动Excel的工作在类的初始化部分

Dim cObj As clsCaller

Set cObj = New clsCaller

'提供函数名称和参数

cObj.MacroName = "MyRand"

cObj.param = 100

MsgBox "调用XLS文件中的MyRand函数，产生0到100之间的一个随机数。" & vbCrLf & cObj.Run()

'提供另一函数的名称和参数
cObj.MacroName = "utrim"
cObj.param = " good better Best "
MsgBox "调用XLS文件中的utrim函数，对字串进行去除首尾空白字符，并转化为大写。" & vbCrLf & cObj.Run()
'提供另一函数的名称和参数
cObj.MacroName = "TGDZ"
cObj.param = 2020
MsgBox "调用XLS文件中的天干地支计算函数，葡京赌博网站葡京赌博网址，将年份2020转化为天干地支" & vbCrLf & cObj.Run()
End Sub

clsCaller是一个设计用来调用的类模块，如下

Private ex As Excel.Application

Private wb As Workbook

Private xlsFN As String

Private xlsMacNm As String

Private xlsMacParam As Variant

Private Const exApp = "Microsoft Excel"

Private strCmmt As String

Public Property Let xlsFilename(xlsFname As String)

xlsFN = GetDocFilePath & "\" & xlsFname

End Property

Public Property Get xlsFilename() As String

xlsFilename = xlsFN

End Property

Public Property Let MacroName(macro As String)

xlsMacNm = macro

End Property

Property Get MacroName() As String

MacroName = xlsMacNm

End Property

Public Property Let Comment(strC$)

strCmmt = strC

End Property

Public Property Get Comment() As String

Comment = strCmmt

End Property

Public Property Get param() As Variant

param = xlsMacParam

End Property

Public Property Let param(pa As Variant)

xlsMacParam = pa

End Property

Public Function Run() As Variant

Run = ex.Run(xlsMacNm, xlsMacParam)

End Function

Private Function GetDocFilePath() As String

GetDocFilePath = ThisDocument.Path

End Function

Private Sub Class_Initialize() '类对象进行初始化，葡京赌博官网，装载EXCEL

Set ex = CreateObject("Excel.Application")

Me.xlsFilename = "函数工具.xls"

Set wb = ex.Workbooks.Open(xlsFN)

End Sub

Private Sub Class_Terminate()'完成之后释放Excel对象

Set wb = Nothing

Set ex = Nothing

If Tasks.Exists(exApp) Then Tasks(exApp).Close

End Sub