VBA Code:


Option Explicit
Sub countMatheVar()
Dim obVariables As Variables
Dim obVariable As Variable
Dim iVariable As Integer
Dim iMatheVarWithForumular As Integer
Dim iMatheVarWithoutForumular As Integer
Dim iConstantsInFormular As Integer
Dim iVariablesInFormular As Integer
Dim strFormular As String
Dim arrFormular
Dim iArrFormular As Integer
Dim strVersion As String
Dim bVersion601 As Boolean
Dim bVersion650 As Boolean
Dim bIsMatheVar As Boolean
'define the delimiters (mathematic operators)
Const C_DELIM_CHARS = "+*-/^"

'NOTE:
'the access via VBA to DynProperties for variables is not possible in 6.01!
'so the normal access via obVariable.DynProperties("MathInfo[0].Formula") will not work!
'-> the the variable object itself contains the formular instead!
'with 6.50 the access to the driver object has been changed due to inconsistency regarding the hierarchical object model (VSTA integration)
'so instead of Driver.Driver use Driver.Name (Note: the former Driver.Name has changed in 6.50 into Driver.Identification)
'so check which zenon version is used
strVersion = ApplicationED.Version
strVersion = Replace(strVersion, ".", "") 'remove the "." -> treat the version as a number

If CInt(strVersion) = 61 Then
bVersion601 = True
Else
bVersion601 = False
If CInt(strVersion) >= 650 Then
bVersion650 = True
Else
bVersion650 = False
End If
End If
'create an object of the variables collection
Set obVariables = MyWorkspace.ActiveDocument.Variables
'loop through all variables
For iVariable = 0 To obVariables.Count - 1
'create an object of the variable
Set obVariable = obVariables.Item(iVariable)

bIsMatheVar = False
'check if the variable bases on the Mathematic driver
If bVersion650 = True Then
If obVariable.Driver.Name = "MATHDR32" Then
bIsMatheVar = True
End If
Else
If obVariable.Driver.Driver = "MATHDR32" Then
bIsMatheVar = True
End If
End If

If bIsMatheVar = True Then
'depending on the zenon version the formular is held in different objects
If bVersion601 = True Then
strFormular = obVariable
Else
strFormular = obVariable.DynProperties("MathInfo[0].Formula")
End If

'check if the mathematic variable does have a formular linked
If strFormular <> "" Then
'ok, a formular is linked to the variable
iMatheVarWithForumular = iMatheVarWithForumular + 1
'split up the formular into an array (split via mathematical operators +*-/^)
arrFormular = SplitMultiDelims(strToSearch:=strFormular, DelimChars:=C_DELIM_CHARS)
If IsArrayAllocated(arrFormular) = True Then
'loop through the array
For iArrFormular = LBound(arrFormular) To UBound(arrFormular)
'now check if it the single entry is a numerical value
'variables (like X01) are no problem - check only constants
If IsNumeric(arrFormular(iArrFormular)) = True Then
iConstantsInFormular = iConstantsInFormular + 1
Else
'single entry is a variable (like X01)
'-> we do not care -> just for statistics
iVariablesInFormular = iVariablesInFormular + 1
End If
Next iArrFormular
End If
Else
'no formular linked
iMatheVarWithoutForumular = iMatheVarWithoutForumular + 1
End If
Set obVariable = Nothing
End If
Next iVariable

'print the result
Debug.Print "Variables total: " & obVariables.Count - 1
Debug.Print "MatheVars with Formulars: " & iMatheVarWithForumular
Debug.Print "MatheVars without Formulars: " & iMatheVarWithoutForumular
Debug.Print "Total variables in Formulars: " & iVariablesInFormular
Debug.Print "--> Total constants in Formulars: " & iConstantsInFormular
MsgBox "Variables total: " & obVariables.Count - 1 & _
vbLf & "MatheVars with Formulars: " & iMatheVarWithForumular & _
vbLf & "MatheVars without Formulars: " & iMatheVarWithoutForumular & _
vbLf & "Total variables in Formulars: " & iVariablesInFormular & _
vbLf & "--> Total constants in Formulars: " & iConstantsInFormular

Set obVariables = Nothing
End Sub

'multiple split function -> from http://www.cpearson.com/excel/splitondelimiters.aspx
Function SplitMultiDelims(strToSearch As String, DelimChars As String) As String()
'This function splits Text into an array of substrings, each substring
'delimited by any character in DelimChars. Only a single character
'may be a delimiter between two substrings, but DelimChars may
'contain any number of delimiter characters. If you need multiple
'character delimiters, use the SplitMultiDelimsEX function. It returns
'an unallocated array it Text is empty, a single element array
'containing all of text if DelimChars is empty, or a 1 or greater
'element array if the Text is successfully split into substrings.
Dim Pos1 As Long
Dim N As Long
Dim M As Long
Dim Arr() As String
Dim I As Long
'if strToSearch is empty, get out
If Len(strToSearch) = 0 Then
Exit Function
End If
'if DelimChars is empty, return original text
If DelimChars = vbNullString Then
SplitMultiDelims = Array(strToSearch)
Exit Function
End If

'oversize the array, we'll shrink it later so
'we don't need to use Redim Preserve
ReDim Arr(1 To Len(strToSearch))

I = 0
N = 0
Pos1 = 1

For N = 1 To Len(strToSearch)
For M = 1 To Len(DelimChars)
If StrComp(Mid(strToSearch, N, 1), Mid(DelimChars, M, 1), vbTextCompare) = 0 Then
I = I + 1
Arr(I) = Mid(strToSearch, Pos1, N - Pos1)
Pos1 = N + 1
N = N + 1
End If
Next M
Next N

If Pos1 <= Len(strToSearch) Then
I = I + 1
Arr(I) = Mid(strToSearch, Pos1)
End If

'chop off unused array elements
ReDim Preserve Arr(1 To I)
SplitMultiDelims = Arr

End Function
Private Function IsArrayAllocated(Arr As Variant) As Boolean
'Returns True or False indicating whether a dynamic
'array is allocated. It supports arrays that are the
'result of functions like Split in which case the
'LBound is greater than the UBound for unallocated
'arrays.
On Error Resume Next
IsArrayAllocated = (IsArray(Arr) = True) And _
(IsError(LBound(Arr, 1)) = False) And _
(LBound(Arr, 1) <= (UBound(Arr, 1)))

End Function