Эта идея может работать на вас. Функция ParamProduct
вызывает SetProps
, которая записывает оба параметра в пользовательские свойства документа (Вид из Файл> Свойства> Расширенные свойства> Пользовательский ). Вызовите функцию с помощью =ParamProduct(A1, A2)
или =ParamProduct(123, 321)
Function ParamProduct(Param1 As Variant, _
Param2 As Variant) As Double
Dim Fun As Double
Dim Param As Variant
Dim i As Integer
Param = Param1
For i = 1 To 2
SetProp "Param" & i, Param
Param = Param2
Next i
ParamProduct = Param1 + Param2
End Function
Private Sub SetProp(Pname As String, _
PropVal As Variant)
' assign PropVal to document Property(Pname)
' create a custom property if it doesn't exist
Dim Pp As DocumentProperty
Dim Typ As MsoDocProperties
If IsNumeric(PropVal) Then
Typ = msoPropertyTypeNumber
Else
Select Case VarType(PropVal)
Case vbDate
Typ = msoPropertyTypeDate
Case vbBoolean
Typ = msoPropertyTypeBoolean
Case Else
Typ = msoPropertyTypeString
End Select
End If
On Error Resume Next
With ThisWorkbook
Set Pp = .CustomDocumentProperties(Pname)
If Err.Number Then
.CustomDocumentProperties.Add Name:=Pname, LinkToContent:=False, _
Type:=Typ, Value:=PropVal
Else
With Pp
If .Type <> Typ Then .Type = Typ
.Value = PropVal
End With
End If
End With
End Sub
. Используйте эту UDF для вызова свойств на листе.
Function GetParam(ByVal Param As String) As Variant
GetParam = Propty(Param)
End Function
Private Function Propty(Pname As String) As Variant
' SSY 050 ++
' return null string if property doesn't exist
Dim Fun As Variant
Dim Pp As DocumentProperty
On Error Resume Next
Set Pp = ThisWorkbook.CustomDocumentProperties(Pname)
If Err.Number = 0 Then
Select Case Pp.Type
Case msoPropertyTypeNumber
Fun = CLng(Fun)
Case msoPropertyTypeDate
Fun = CDate(Fun)
Case msoPropertyTypeBoolean
Fun = CBool(Fun)
Case Else
Fun = CStr(Fun)
End Select
Fun = Pp.Value
End If
Функция на листе ниже работает (A6 имеет значение of "Param2") =GetParam("Param1")*GetParam(A6)
Приведенный выше код создаст свойство, если оно не существует, или изменит его значение, если оно существует. Подпрограмма ниже удалит существующее свойство и ничего не сделает, если вызывается для удаления несуществующего свойства. Вы можете вызвать его из одной из вышеперечисленных подпрограмм или функций.
Private Sub DelProp(ByVal Pname As String)
On Error Resume Next
ThisWorkbook.CustomDocumentProperties(Pname).Delete
Err.Clear
End Sub