Thread: Excel 97 Enum
View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Peter T Peter T is offline
external usenet poster
 
Posts: 5,600
Default Excel 97 Enum

Er - anything else you need whilst I'm rewriting an unfriendly looking 500
lines! Well that was my first reaction but curiosity made me take a look.

In terms of the Enum and Property stuff there's very little to do, and that
along the lines I suggested previously. The "Public" constants need to go in
a normal module, not a Class.

However the code includes string functions Join, InstrRev and Split which
were new to VBA6 and won't work in XL97. I've included some alternatives for
XL97, some my own and an adapted version of a Split as suggestion by MS. But
I cannot figure one line

ValueList(strValue) = Split(arg's)

ValueList is a reference to ScriptingDictionary, don't know how this accepts
an array, or what sort of array. Does this work OK in the original? You
might post another question about this, extract the minimum necessary from
the code, the original reference and usage. Include the #If VBA6 then Split
lines and the Split97sArr routine.

In the class module:
Comment the Enum's
Replace original lines ending indicated ending in '##

#If VBA6 Then
Property Let Root(lProp As RegRoot) '##
#Else
Property Let Root(lProp As Long)
#End If

#If VBA6 Then
Property Let Options(lProp As RegOptions)
#Else
Property Let Options(lProp As Long)
#End If

#If VBA6 Then
sTemp = Join(vData, vbNullChar) & String$(2, 0) '##
#Else
sTemp = Join97(vData, vbNullChar) & String$(2, 0)
#End If

#If VBA6 Then
n = InStrRev(strKeyName, "\") '##
#Else
n = InStrRev97(strKeyName, "\")
#End If

#If VBA6 Then
If n = InStrRev(strTest, PCT) Then Exit Function '##
#Else
If n = InStrRev97(strTest, PCT) Then Exit Function
#End If

#If VBA6 Then
EnvSplit = Split(Env, "=") '##
#Else
Split97StrArr EnvSplit, Env, "="
#End If

''Private ValueList As Object
''Set ValueList = CreateObject("Scripting.Dictionary")
''code

#If VBA6 Then
ValueList(strValue) = Split( _
TrimDoubleNull(strBuffer), vbNullChar) '##
#Else
Dim sArr() As String 'new array to pass to Split97sArr
Split97StrArr sArr(), TrimDoubleNull(strBuffer), vbNullChar

'ValueList(strValue) = sArr() 'how ????????

#End If


''In a normal module

#If VBA6 Then
Public Enum RegOptions ' variable: lOptions
StoreNumbersAsStrings = 1
ReturnMultiStringsAsArrays = 2
ExpandEnvironmentStrings = 4
ShowErrorMessages = 8
End Enum

Public Enum RegRoot ' variable: lRoot
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001 ' default
HKEY_LOCAL_MACHINE = &H80000002
End Enum
#Else
Public Const StoreNumbersAsStrings As Long = 1
Public Const ReturnMultiStringsAsArrays As Long = 2
Public Const ExpandEnvironmentStrings As Long = 4
Public Const ShowErrorMessages As Long = 8

Public Const HKEY_CLASSES_ROOT As Long = &H80000000
Public Const HKEY_CURRENT_USER As Long = &H80000001
Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
#End If


Function Join97(vArr, Optional sDelim As String) As String
Dim s As String, i As Long
On Error GoTo errH
If VarType(vArr) = vbArray Then
s = vArr(LBound(vArr))
If UBound(vArr) Then
For i = 1 To UBound(vArr)
If Len(sDelim) Then s = s & sDelim
s = s & vArr(i)
Next
End If
Join97 = s
Else
Join97 = CStr(vArr)
End If
errH:
If Err.Number < 0 Then
'stop '????
End If
End Function

Function InStrRev97(s1 As String, s2 As String, _
Optional nCompare As Long = vbBinaryCompare) As Long
Dim i As Long, nPos As Long

For i = Len(s1) To 1 Step -1
nPos = InStr(i, s1, s2, nCompare)
If nPos Then
InStrRev97 = nPos
Exit Function
End If
Next i

End Function

Sub Split97StrArr(sOut() As String, ByVal sIn As String, _
Optional sDelim As String, Optional nLimit As Long = -1, _
Optional nCompare As Long = vbBinaryCompare)
'http://support.microsoft.com/default.aspx?scid=kb;en-us;188007
'adapted from a function that returns a variant (array) to a Sub
'that accepts a string array
'also, MS's original VB5 version does not compile in xl97

Dim sRead As String, nC As Integer
If sDelim = "" Then
ReDim sOut(0)
sOut(0) = sIn
Else
sRead = ReadUntil(sIn, sDelim, nCompare)
Do
ReDim Preserve sOut(nC)
sOut(nC) = sRead
nC = nC + 1
If nLimit < -1 And nC = nLimit Then Exit Do
sRead = ReadUntil(sIn, sDelim)
Loop While sRead < ""
ReDim Preserve sOut(nC)
sOut(nC) = sIn
End If

End Sub

Function ReadUntil(ByRef sIn As String, _
sDelim As String, _
Optional nCompare As Long = vbBinaryCompare) As String
'MS's original "nPos as String" which seems strange
Dim nPos As Long
nPos = InStr(1, sIn, sDelim, nCompare)
If nPos 0 Then
ReadUntil = Left(sIn, nPos - 1)
sIn = Mid(sIn, nPos + Len(sDelim))
End If
End Function
'' end normal module

With these changes the code should compile in XL97. However the
"ValueList(strValue) = Split..." needs sorting out. Also, I haven't tried
any of this so can't be sure it'll work - a lot of registry stuff but what's
it all about?

Regards,
Peter T



"Larry Dodd" wrote in message
...
Thank you for your help on this but since it is not my code I am not sure

how
to implement this. I have included all the code that is in the RegOp

class.
If you could help me with the changes that are necessary I would

appreciate
it.


500+ lines of code snipped