fpSpread7.0控件是一款仿Excel的表格控件，其内带功能比较强大，可以从Excel文件导入/导出数据，并在单元格中封装了部分函数。鉴于fpSpread7.0的中文资料很少，故将本人在开发过程中的使用心得写出，以供参考。本文重点介绍如何在Script环境下为fpSpread7.0添加自定义函数。本文的开发环境为vbScript
一、自定义函数声明
首先在页面初始化fpSpread控件时使用 AddCustomFunction声明要定义的函数名"VLOOKUP"与"INDEX"。函数参数分别为6个与7个，函数功能与Excel中同名函数相同。以下是控件的属性设置与函数声明
vs.ScriptEnhanced = True '在脚本环境下，属性ScriptEnhanced 必须设置为True
Call vs.AddCustomFunction("VLOOKUP",6)
Call vs.AddCustomFunction("INDEX",7)
1.函数VLOOKUP的参数表如下
| 参数 | 描述 |
| CELL_NAME | 要与目标区域进行对比的格子，例如"A1" |
| START_COL | 要查询区域的起始列 |
| START_ROW | 要查询区域的起始行 |
| END_COL | 要查询区域的终止列 |
| END_ROW | 要查询区域的终止行 |
| RESULT_COL | 匹配成功后要返回结果值所在的列 |
在指定某格的函数时，代码如下：
vs.Col = 2
vs.Row = 1
vs.Formula = "VLOOKUP(A1,1,50,1,62,1)"
运行时B1格的函数会根据A1格的内容搜索从1列50行至1列62行间可以匹配A1数值的行，并返回该行的第1列值。
其中需要注意的是A1与B1格的CellType都应被指定为数值类型。
2.函数INDEX的参数表如下
| 参数 | 描述 |
| START_COL | 要查询区域的起始列 |
| START_ROW | 要查询区域的起始行 |
| END_COL | 要查询区域的终止列 |
| END_ROW | 要查询区域的终止行 |
| TARGET_COL | 目标格所在的列 |
| TARGET_ROW | 目标格所在的行 |
| RESULT_COL | 匹配成功后要返回结果值所在的列 |
在指定某格的函数时，代码如下：
vs.Col = 2
vs.Row = 1
vs.Formula = "If(A1<>"""", INDEX(1,83,1,84,1,1,2))"运行时B1格的函数会在A1选中一个选项时，根据A1格的内容搜索从1列83行至1列844行间可以匹配A1数值的行，并返回该行的第2列值。
在这里我在指定目标格的方法时有所差别，因为在VLOOKUP中，目标格是数值类型的，通过格子名可以直接取到该格的值,而Index函数所面对的目标格是Combo类型的，如果直接取格子名，在函数执行时会返回一个空值或错误。
二、实现自定义函数
sub vs_ScriptCustomFunction (ByVal FunctionName, ByVal ParameterCnt, ByVal Col, ByVal Row,Byval CFStatus)
'On Error Resume Next
'状态变量
Const ValueStatusEmpty = 2
Const ValueStatusError = 1
Const ValueStatusOK = 0
'参数变量
Const ValueTypeCellRef = 3
Const ValueTypeDouble = 1
Const ValueTypeLong = 0
Const ValueTypeRangeRef = 4
Const ValueTypeString = 2
Dim Flag
Dim vResult
'目标Cell
Dim tRow,tCol,tValue
'范围Cell
Dim sRow,sCol,eRow,eCol,lValue,TempValue '存放临时最接近tValue的值
'索引列
Dim indexCol,rRow
'参数状态
Dim ArgType,ArgStatus
'循环变量
Dim lRow,lCol
If FunctionName = "VLOOKUP" then
'读取参数
Flag = vs.ScriptCFGetParamInfo (1, ArgType, ArgStatus)
if ArgStatus = ValueStatusOK then
If ArgType = ValueTypeDouble then
tValue = vs.CFGetDoubleParam (1)
end if
If ArgType = ValueTypeLong then
tValue = vs.CFGetLongParam(1)
end if
end if
Flag = vs.ScriptCFGetParamInfo(2, ArgType, ArgStatus)
if ArgStatus = ValueStatusOK then
If ArgType = ValueTypeDouble then
sCol = vs.CFGetDoubleParam(2)
end if
If ArgType = ValueTypeLong then
sCol = vs.CFGetLongParam(2)
end if
end if
Flag = vs.ScriptCFGetParamInfo(3, ArgType, ArgStatus)
if ArgStatus = ValueStatusOK then
If ArgType = ValueTypeDouble then
sRow = vs.CFGetDoubleParam(3)
end if
If ArgType = ValueTypeLong then
sRow = vs.CFGetLongParam(3)
end if
end if
Flag = vs.ScriptCFGetParamInfo(4, ArgType, ArgStatus)
if ArgStatus = ValueStatusOK then
If ArgType = ValueTypeDouble then
eCol = vs.CFGetDoubleParam(4)
end if
If ArgType = ValueTypeLong then
eCol = vs.CFGetLongParam(4)
end if
end if
Flag = vs.ScriptCFGetParamInfo(5, ArgType, ArgStatus)
if ArgStatus = ValueStatusOK then
If ArgType = ValueTypeDouble then
eRow = vs.CFGetDoubleParam(5)
end if
If ArgType = ValueTypeLong then
eRow = vs.CFGetLongParam(5)
end if
end if
Flag = vs.ScriptCFGetParamInfo(6, ArgType, ArgStatus)
if ArgStatus = ValueStatusOK then
If ArgType = ValueTypeDouble then
indexCol = vs.CFGetDoubleParam(6)
end if
If ArgType = ValueTypeLong then
indexCol = vs.CFGetLongParam(6)
end if
end if
'给临时变量赋初始值
rRow = -1
TempValue = -10000
For lRow = sRow to eRow
For lCol = sCol to eCol
with vs
.Row = lRow
.Col = lCol
lValue = .Value
'msgbox(CLNG(tValue) & "-" & CLNG(lValue) & "-" & CLNG(TempValue))
if (CLNG(tValue) >= CLNG(lValue)) and (CLNG(lValue) > CLNG(TempValue)) then
TempValue = lValue
rRow = lRow
end if
end with
Next
Next
if rRow <> -1 then
with Edit2008
.Row = rRow
.Col = IndexCol
vResult = .Value
CFStatus = ValueStatusOK
end with
end if
end if
If FunctionName = "INDEX" then
'读取参数
Flag = vs.ScriptCFGetParamInfo (1, ArgType, ArgStatus)
if ArgStatus = ValueStatusOK then
If ArgType = ValueTypeDouble then
sCol = vs.CFGetDoubleParam (1)
end if
If ArgType = ValueTypeLong then
sCol = vs.CFGetLongParam (1)
end if
end if
Flag = vs.ScriptCFGetParamInfo(2, ArgType, ArgStatus)
if ArgStatus = ValueStatusOK then
If ArgType = ValueTypeDouble then
sRow = vs.CFGetDoubleParam(2)
end if
If ArgType = ValueTypeLong then
sRow = vs.CFGetLongParam (2)
end if
end if
Flag = vs.ScriptCFGetParamInfo(3, ArgType, ArgStatus)
if ArgStatus = ValueStatusOK then
If ArgType = ValueTypeDouble then
eCol = vs.CFGetDoubleParam(3)
end if
If ArgType = ValueTypeLong then
eCol = vs.CFGetLongParam (3)
end if
end if
Flag = vs.ScriptCFGetParamInfo(4, ArgType, ArgStatus)
if ArgStatus = ValueStatusOK then
If ArgType = ValueTypeDouble then
eRow = vs.CFGetDoubleParam(4)
end if
If ArgType = ValueTypeLong then
eRow = vs.CFGetLongParam (4)
end if
end if
Flag = vs.ScriptCFGetParamInfo(5, ArgType, ArgStatus)
if ArgStatus = ValueStatusOK then
If ArgType = ValueTypeDouble then
tCol = vs.CFGetDoubleParam(5)
end if
If ArgType = ValueTypeLong then
tCol = vs.CFGetLongParam (5)
end if
end if
Flag = vs.ScriptCFGetParamInfo(6, ArgType, ArgStatus)
if ArgStatus = ValueStatusOK then
If ArgType = ValueTypeDouble then
tRow = vs.CFGetDoubleParam(6)
end if
If ArgType = ValueTypeLong then
tRow = vs.CFGetLongParam (6)
end if
end if
Flag = vs.ScriptCFGetParamInfo(7, ArgType, ArgStatus)
if ArgStatus = ValueStatusOK then
If ArgType = ValueTypeDouble then
indexCol = vs.CFGetDoubleParam(7)
end if
If ArgType = ValueTypeLong then
indexCol = vs.CFGetLongParam (7)
end if
end if
with vs
.Row = tRow
.Col = tCol
tValue = .Text
end with
rRow = -1
For lRow = sRow to eRow
For lCol = sCol to eCol
with vs
.Row = lRow
.Col = lCol
lValue = .Text
if tValue = lValue then
rRow = lRow
exit for
end if
end with
Next
Next
if rRow <> -1 then
with vs
.Row = rRow
.Col = IndexCol
vResult = .Value
CFStatus = ValueStatusOK
end with
end if
end if
If CFStatus = ValueStatusOK Then
IF vResult <> "" then
call vs.CFSetResult (CDBL(vResult))
else
call vs.CFSetResult (0)
End if
End If
end sub
上面的代码有兴趣的朋友可以参考fpspread7.0 Online Help中CustomFunction, ScriptCustomFunction Events一节对比进行参考。
需要说明的是在vbScript中取得数值时经常会因为CDBL、CINT、CLNG等函数所取得的参数为空而导致脚本中止，因此在Script环境下编写自定义函数时要格外注意。
527
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
