D
Darrell
I updated the declare functions but I do not see what else is missing. File
works great in 07 and 2010 32 bit - but will not work in excel 64 bit. Wht is
my code missing for it to inialize the connection within the 64 bit excel
2010 model?
Any help would be greatly appreciated:
Declare PtrSafe Function sndPlaySound32 Lib "winmm.dll" Alias
"sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Dim clnt As New SoapClient30
Dim uname As String
Dim LogID As String
Dim isloggedin As Integer
Dim refreshrate As String
Dim isinitialized As Integer
Dim allowedMarkets As String
Dim alwdmktids() As String
Dim MktCells() As String
Dim MktCols() As String
Dim MktNames() As String
Dim MktTitles() As String
Dim MktCGreater() As String
Dim MktCLesser() As String
Dim MktLimitLess() As String
Dim MktLimitGreat() As String
Dim MktLimitEqual() As String
Dim MktColorString() As String
Dim MktColorLess() As String
Dim MktColorGreat() As String
Dim MktColorEqual() As String
Dim MktColorLess2() As String
Dim MktColorHeader() As String
Dim MktColorRowHeader() As String
Dim MktColorColHeader() As String
Dim MktColorColString() As String
Dim conditionsloaded As Integer
Dim clearcondition As String
Dim firsttime As Integer
Dim delsheetid As Integer
Dim delsheetcell As Integer
Dim ConExecting
Dim Cond_with_Market
Dim TheConditionString As String
Public Const SND_ASYNC = &H1
Public Const SND_SYNC = &H0
Public Const SND_LOOP = &H8
Dim conditions_are_true As Integer
Dim Old_Mkt_Values() As String
Public Sub startclient()
On Error GoTo Handler
If isinitialized <> 1 Then
clnt.MSSoapInit "http://networksmarter.com/WebService.asmx?WSDL"
'clnt.MSSoapInit "http://networksmarter.com/WebService.asmx?WSDL"
Sheets(1).Cells(16, 6) = "Please login to get signals"
isinitialized = 1
End If
Exit Sub
Handler:
Sheets(1).Cells(16, 6) = "Soap client not initialized with the server"
Exit Sub
End Sub
Public Sub stopclient()
Sheets(1).Cells(16, 6) = "Disconnected"
End Sub
Public Sub AttachedNodes()
If IsEmpty(ConExecting) Then
ReDim ConExecting(0) As Integer
ConExecting(UBound(ConExecting)) = 0
Else
ReDim Preserve ConExecting(UBound(ConExecting) + 1)
ConExecting(UBound(ConExecting)) = 0
End If
ReDim Preserve ConExecting(UBound(ConExecting) + 1)
ConExecting(UBound(ConExecting)) = 0
End Sub
Public Function login()
On Error GoTo Handler
If isinitialized = 1 Then
Dim str As String
str = clnt.LoginUserSite(Sheets(1).txtUsername.Text,
Sheets(1).txtPassword.Text, "")
conditions_are_true = 0
If (InStr(str, "Done")) Then
Dim sarrtyn() As String
sarrtyn = Split(str, "~")
LogID = sarrtyn(1)
firsttime = 1
uname = Sheets(1).txtUsername.Text
Sheets(1).Cells(16, 6) = "Connected"
Sheets(1).ButtonLogin.Caption = "Disconnect"
Call clnt.checkuser(uname, LogID)
isloggedin = 1
CollectAllowedMarkets
'refreshrate = "00:00:04"
'Application.OnTime EarliestTime:=Now + TimeValue(refreshrate),
Procedure:="RefreshValues"
oprprog = 0
Else
Sheets(1).Cells(16, 6) = str
End If
End If
Exit Function
Handler:
End Function
Public Function logout()
If isloggedin = 1 Then
Call clnt.LogoutUser(uname, LogID)
Sheets(1).ButtonLogin.Caption = "Connect"
Sheets(1).Cells(16, 6) = "Not Connected"
uname = ""
isloggedin = 0
Application.DisplayAlerts = False
For i = 2 To Sheets.Count
Sheets(2).Delete
Next
Application.DisplayAlerts = True
End If
End Function
Public Function CollectAllowedMarkets()
allowedMarkets = clnt.allowedMarkets(uname)
alwdmktids = Split(allowedMarkets, "~")
'Old_Mkt_Values = Split(allowedMarkets, "~")
MktCells = alwdmktids
MktCols = alwdmktids
MktNames = alwdmktids
MktTitles = alwdmktids
MktCGreater = alwdmktids
MktCLesser = alwdmktids
MktLimitLess = alwdmktids
MktLimitGreat = alwdmktids
MktLimitEqual = alwdmktids
MktColorLess = alwdmktids
MktColorLess2 = alwdmktids
MktColorGreat = alwdmktids
MktColorEqual = alwdmktids
MktColorString = alwdmktids
MktColorHeader = alwdmktids
MktColorRowHeader = alwdmktids
MktColorColHeader = alwdmktids
MktColorColString = alwdmktids
For i = 0 To UBound(alwdmktids)
Dim str As String
str = clnt.MarketColors(uname, alwdmktids(i))
Dim strarr() As String
strarr = Split(str, "~")
MktCells(i) = strarr(0)
MktCols(i) = strarr(1)
MktNames(i) = strarr(2)
MktTitles(i) = strarr(3)
MktCGreater(i) = strarr(4)
'MsgBox MktCGreater(i)
MktCLesser(i) = strarr(5)
'MsgBox MktCLesser(i)
MktColorGreat(i) = strarr(6)
MktColorLess(i) = strarr(7)
MktColorEqual(i) = strarr(8)
MktColorLess2(i) = strarr(9)
MktColorString(i) = strarr(10)
MktColorHeader(i) = strarr(11)
MktLimitGreat(i) = strarr(12)
MktLimitLess(i) = strarr(13)
MktLimitEqual(i) = strarr(14)
MktColorColHeader(i) = strarr(15)
MktColorRowHeader(i) = strarr(16)
MktColorColString(i) = strarr(17)
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = MktNames(i)
'ActiveSheet.Name = "Sheet" + CStr(i + 8)
Sheets(i + 2).Cells(1, 1) = MktNames(i)
Sheets(i + 2).Cells(3, 1) = "Custom Fields"
Sheets(i + 2).Cells(3, 3) = MktTitles(i)
Dim colcordnates() As String
colcordnates = Split(MktColorHeader(i), "|")
Sheets(i + 2).Cells(3, 3).Interior.Color = RGB(CInt(colcordnates(0)),
CInt(colcordnates(1)), CInt(colcordnates(2)))
With Sheets(i + 2).Range("C3:H3")
.Merge Across:=True
End With
Dim Formuid As Integer
Formuid = ((CInt(alwdmktids(i)) - 1) * 5)
For j = 1 To 5
str = clnt.GetFormula(uname, Formuid + j)
Dim avarSplit() As String
If (str <> "") Then
Dim thecol As String
thecol = ""
avarSplit = Split(str, "~")
For ii = 0 To UBound(avarSplit)
If ii Mod 2 = 0 Then
If InStr(avarSplit(ii), "c") = 0 Then
Dim rownum As Integer
rownum = CInt(avarSplit(ii)) \ CInt(MktCols(i))
rownum = rownum + 4
Dim colnum As Integer
colnum = CInt(avarSplit(ii)) Mod CInt(MktCols(i))
thecol = thecol & Chr(67 + colnum) & CStr(rownum)
Else
thecol = thecol & Mid(avarSplit(ii), 2, Len(avarSplit(ii)))
End If
Else
thecol = thecol & avarSplit(ii)
End If
Next ii
Sheets(i + 2).Cells(j + 3, 1) = "=" & thecol
End If
Next j
Next i
refreshrate = "00:00:02"
conditionsloaded = 0
RefreshValues
End Function
Public Sub CollectConditions()
For ii = 0 To UBound(alwdmktids)
Dim Formuids() As String
Dim formus As String
formus = clnt.GetCustomFormulaIDs(uname, alwdmktids(ii))
If formus <> "" Then
Formuids = Split(formus, "~")
Dim i, j, k As Integer
j = 0
For i = 0 To UBound(Formuids)
formus = clnt.GetCustomFormula(uname, Formuids(i))
Dim TempFOrmu() As String
TempFOrmu = Split(formus, "|")
Dim funparts() As String
funparts = Split(TempFOrmu(0), "~")
Dim tempcondition As String 'this condition would be installed
tempcondition = "=TestExec("
TheConditionString = MktNames(ii) & ": "
For k = 0 To UBound(funparts) 'left side
If InStr(funparts(k), "formu") = 0 Then 'the formula field is
there then false
If k Mod (2) = 1 Then
tempcondition = tempcondition + funparts(k)
TheConditionString = TheConditionString + CStr(k)
Else
TheConditionString = TheConditionString + "cell" + funparts(k)
Dim rownum As Integer
rownum = CInt(funparts(k)) \ CInt(MktCols(ii))
rownum = rownum + 4
Dim colnum As Integer
colnum = CInt(funparts(k)) Mod CInt(MktCols(ii))
tempcondition = tempcondition + Chr(67 + colnum) + CStr(rownum)
End If
Else
Select Case funparts(k)
Case "formu1"
tempcondition = tempcondition + "A4"
TheConditionString = TheConditionString + "Custom 1"
Case "formu2"
tempcondition = tempcondition + "A5"
TheConditionString = TheConditionString + "Custom 2"
Case "formu3"
tempcondition = tempcondition + "A6"
TheConditionString = TheConditionString + "Custom 3"
Case "formu4"
tempcondition = tempcondition + "A7"
TheConditionString = TheConditionString + "Custom 4"
Case Else
tempcondition = tempcondition + "A8"
TheConditionString = TheConditionString + "Custom 5"
End Select
End If
Next 'Left side condition
If TempFOrmu(1) = "==" Then
tempcondition = tempcondition + ", ""="", "
TheConditionString = TheConditionString + " == "
Else
tempcondition = tempcondition + ", """ + TempFOrmu(1) + """, "
TheConditionString = TheConditionString + " " + TempFOrmu(1) + " "
End If 'Condition added
funparts = Split(TempFOrmu(2), "~")
For k = 0 To UBound(funparts) 'right side
If InStr(funparts(k), "formu") = 0 Then 'the formula field is
there then false
If k Mod (2) = 1 Then
tempcondition = tempcondition + funparts(k)
TheConditionString = TheConditionString + funparts(k)
Else
TheConditionString = TheConditionString + "cell" + funparts(k)
rownum = CInt(funparts(k)) \ CInt(MktCols(ii))
rownum = rownum + 4
colnum = CInt(funparts(k)) Mod CInt(MktCols(ii))
tempcondition = tempcondition + Chr(67 + colnum) + CStr(rownum)
End If
Else
Select Case funparts(k)
Case "formu1"
tempcondition = tempcondition + "A4"
TheConditionString = TheConditionString + "Custom 1"
Case "formu2"
tempcondition = tempcondition + "A5"
TheConditionString = TheConditionString + "Custom 2"
Case "formu3"
tempcondition = tempcondition + "A6"
TheConditionString = TheConditionString + "Custom 3"
Case "formu4"
tempcondition = tempcondition + "A7"
TheConditionString = TheConditionString + "Custom 4"
Case Else
tempcondition = tempcondition + "A8"
TheConditionString = TheConditionString + "Custom 5"
End Select
End If
Next 'Right side condition
'check if the condition is already executing
If IsEmpty(ConExecting) Then
ReDim ConExecting(0) As Integer
ReDim Cond_with_Market(0) As String
ConExecting(UBound(ConExecting)) = 0
Cond_with_Market(UBound(Cond_with_Market)) = TheConditionString
Else
ReDim Preserve ConExecting(UBound(ConExecting) + 1)
ReDim Preserve Cond_with_Market(UBound(Cond_with_Market) + 1)
ConExecting(UBound(ConExecting)) = 0
Cond_with_Market(UBound(Cond_with_Market)) = TheConditionString
End If
tempcondition = tempcondition + ", """ + TempFOrmu(3) + """, """
+ Formuids(i) + """," + CStr(4 + j) + ", " + CStr(ii + 2) + ", " +
CStr(UBound(ConExecting)) + ", "" " + TempFOrmu(4) + " """ + ")"
'tempcondition = tempcondition + ", """ + TempFOrmu(3) + """,
""" + Formuids(i) + """," + CStr(4 + j) + ", " + CStr(ii + 2) + ", " +
CStr(UBound(ConExecting)) + ")"
Sheets(ii + 2).Cells(4 + j, 2) = tempcondition
tempcondition = ""
j = j + 1
Next i
End If
Next ii
Exit Sub
End Sub
Public Sub RefreshValues()
On Error GoTo Handler
MousePointer = vbNormal
If Sheets(1).ButtonLogin.Caption <> "Connect" Then
Dim colcordnates() As String
For i = 0 To UBound(alwdmktids)
Dim str As String
str = clnt.CollectInfoMarketNew(uname, alwdmktids(i), LogID)
'If Not Old_Mkt_Values(i) = str Then
'Old_Mkt_Values(i) = str
Dim avarSplit() As String
avarSplit = Split(str, "~")
Dim ii, j, k As Integer
j = 6
k = 0
Dim totrows As Integer
totrows = CInt(MktCells(i)) \ CInt(MktCols(i))
If UBound(avarSplit) + 1 >= CInt(MktCells(i)) Then
For ii = 0 To totrows - 1
For j = 0 To CInt(MktCols(i)) - 1
If IsNumeric(avarSplit(k)) And avarSplit(k) <> "" Then
If CheckValueOp(Sheets(i + 2).Cells(ii + 4, j + 3),
MktLimitLess(i), ">=") Then
colcordnates = Split(MktColorLess(i), "|")
Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color =
RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
End If
If CheckValueOp(Sheets(i + 2).Cells(ii + 4, j + 3),
MktLimitEqual(i), ">=") Then
colcordnates = Split(MktColorEqual(i), "|")
Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color =
RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
End If
If CheckValueOp(Sheets(i + 2).Cells(ii + 4, j + 3),
MktLimitGreat(i), ">=") Then
colcordnates = Split(MktColorGreat(i), "|")
Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color =
RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
End If
If CheckValueOp(Sheets(i + 2).Cells(ii + 4, j + 3),
MktLimitLess(i), "<") Then
colcordnates = Split(MktColorLess2(i), "|")
Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color =
RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
End If
If Sheets(i + 2).Cells(ii + 4, j + 3) <>
avarSplit(k) Then
If chkLess(Sheets(i + 2).Cells(ii + 4, j + 3),
avarSplit(k)) Then
colcordnates = Split(MktCGreater(i), "|")
Sheets(i + 2).Cells(ii + 4, j +
3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)),
CInt(colcordnates(2)))
Else
colcordnates = Split(MktCLesser(i), "|")
Sheets(i + 2).Cells(ii + 4, j +
3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)),
CInt(colcordnates(2)))
End If
Sheets(i + 2).Cells(ii + 4, j + 3) = avarSplit(k)
End If
Else
If avarSplit(k) = "" Then
Sheets(i + 2).Cells(ii + 4, j +
3).Interior.Color = RGB(255, 255, 255)
Sheets(i + 2).Cells(ii + 4, j + 3) = avarSplit(k)
Else
colcordnates = Split(MktColorString(i), "|")
Sheets(i + 2).Cells(ii + 4, j +
3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)),
CInt(colcordnates(2)))
Sheets(i + 2).Cells(ii + 4, j + 3) = avarSplit(k)
End If
End If
If k Mod CInt(MktCols(i)) = 0 Then
colcordnates = Split(MktColorRowHeader(i), "|")
Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color =
RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
End If
If k < CInt(MktCols(i)) Then
colcordnates = Split(MktColorColHeader(i), "|")
Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color =
RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
End If
If avarSplit(k) = "" Then
colcordnates = Split(MktColorColString(i), "|")
Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color =
RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
End If
k = k + 1
Next j
Next ii
End If
'End If
Next i
If conditionsloaded = 1 Then
Application.OnTime EarliestTime:=Now + TimeValue(refreshrate),
Procedure:="RefreshValues"
Else
If firsttime = 1 Then
CollectConditions
Application.OnTime EarliestTime:=Now + TimeValue(refreshrate),
Procedure:="RefreshValues"
conditionsloaded = 1
Else
Sheets(delsheetid).Cells(delsheetcell, 2) = ""
Application.OnTime EarliestTime:=Now + TimeValue(refreshrate),
Procedure:="RefreshValues"
conditionsloaded = 1
firsttime = 1
End If
End If
End If
Exit Sub
Handler:
Application.OnTime EarliestTime:=Now + TimeValue(refreshrate),
Procedure:="RefreshValues"
Exit Sub
End Sub
Public Function TestExec(lftsde, cditon, rhtsde, opration, Formuid,
ClearCellid, ClearSheetid, FormulaIndex, cond_text_sp)
TestExec = "Alert Not Triggered"
If Evaluate(lftsde & cditon & rhtsde) Then
If ConExecting(FormulaIndex) = 0 Then
If opration = "1" Then
Call clnt.SendAlert(uname, Cond_with_Market(FormulaIndex),
Formuid)
TestExec = "Alert Triggered"
Else
If conditions_are_true = 0 Then
Call sndPlaySound32("C:\Program Files\Signal System
Client\success.wav", SND_ASYNC + SND_LOOP)
End If
conditions_are_true = conditions_are_true + 1
If opration = "2" Then
Call clnt.Event_Log(uname, Cond_with_Market(FormulaIndex),
"", "Play alarm")
Else
Call clnt.Event_Log(uname, Cond_with_Market(FormulaIndex),
cond_text_sp, "Timer")
End If
TestExec = "Alert Triggered"
End If 'the condition whether operation is 1 or other
ConExecting(FormulaIndex) = 1
Else
If opration <> "1" Then
'Call sndPlaySound32("C:\Program Files\Signal System
Client\success.wav", SND_ASYNC + SND_LOOP)
TestExec = "Alert Triggered"
End If
End If 'already executing operation or not
Else
If ConExecting(FormulaIndex) = 1 Then
ConExecting(FormulaIndex) = 0
conditions_are_true = conditions_are_true - 1
If conditions_are_true = 0 Then
Call sndPlaySound32("C:\Program Files\Signal System
Client\none.wav", 1)
End If
End If
End If 'end of evaluation
End Function
Public Function CheckValueOp(leftvalue, rightvalue, compoperator) As
Boolean
On Error GoTo Handler
If compoperator = "==" Then
If CDbl(leftvalue) = CDbl(rightvalue) Then
CheckValueOp = True
Else
CheckValueOp = False
End If
Exit Function
End If
If compoperator = "<" Then
If CDbl(leftvalue) < CDbl(rightvalue) Then
CheckValueOp = True
Else
CheckValueOp = False
End If
Exit Function
End If
If compoperator = ">=" Then
If CDbl(leftvalue) >= CDbl(rightvalue) Then
CheckValueOp = True
Else
CheckValueOp = False
End If
Exit Function
End If
Handler:
CheckValueOp = False
End Function
Public Function chkLess(frstvalu, scndvalu) As Boolean
On Error GoTo Handler
If CDbl(frstvalu) < CDbl(scndvalu) Then
chkLess = True
Else
chkLess = False
End If
Exit Function
Handler:
chkLess = False
End Function
works great in 07 and 2010 32 bit - but will not work in excel 64 bit. Wht is
my code missing for it to inialize the connection within the 64 bit excel
2010 model?
Any help would be greatly appreciated:
Declare PtrSafe Function sndPlaySound32 Lib "winmm.dll" Alias
"sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Dim clnt As New SoapClient30
Dim uname As String
Dim LogID As String
Dim isloggedin As Integer
Dim refreshrate As String
Dim isinitialized As Integer
Dim allowedMarkets As String
Dim alwdmktids() As String
Dim MktCells() As String
Dim MktCols() As String
Dim MktNames() As String
Dim MktTitles() As String
Dim MktCGreater() As String
Dim MktCLesser() As String
Dim MktLimitLess() As String
Dim MktLimitGreat() As String
Dim MktLimitEqual() As String
Dim MktColorString() As String
Dim MktColorLess() As String
Dim MktColorGreat() As String
Dim MktColorEqual() As String
Dim MktColorLess2() As String
Dim MktColorHeader() As String
Dim MktColorRowHeader() As String
Dim MktColorColHeader() As String
Dim MktColorColString() As String
Dim conditionsloaded As Integer
Dim clearcondition As String
Dim firsttime As Integer
Dim delsheetid As Integer
Dim delsheetcell As Integer
Dim ConExecting
Dim Cond_with_Market
Dim TheConditionString As String
Public Const SND_ASYNC = &H1
Public Const SND_SYNC = &H0
Public Const SND_LOOP = &H8
Dim conditions_are_true As Integer
Dim Old_Mkt_Values() As String
Public Sub startclient()
On Error GoTo Handler
If isinitialized <> 1 Then
clnt.MSSoapInit "http://networksmarter.com/WebService.asmx?WSDL"
'clnt.MSSoapInit "http://networksmarter.com/WebService.asmx?WSDL"
Sheets(1).Cells(16, 6) = "Please login to get signals"
isinitialized = 1
End If
Exit Sub
Handler:
Sheets(1).Cells(16, 6) = "Soap client not initialized with the server"
Exit Sub
End Sub
Public Sub stopclient()
Sheets(1).Cells(16, 6) = "Disconnected"
End Sub
Public Sub AttachedNodes()
If IsEmpty(ConExecting) Then
ReDim ConExecting(0) As Integer
ConExecting(UBound(ConExecting)) = 0
Else
ReDim Preserve ConExecting(UBound(ConExecting) + 1)
ConExecting(UBound(ConExecting)) = 0
End If
ReDim Preserve ConExecting(UBound(ConExecting) + 1)
ConExecting(UBound(ConExecting)) = 0
End Sub
Public Function login()
On Error GoTo Handler
If isinitialized = 1 Then
Dim str As String
str = clnt.LoginUserSite(Sheets(1).txtUsername.Text,
Sheets(1).txtPassword.Text, "")
conditions_are_true = 0
If (InStr(str, "Done")) Then
Dim sarrtyn() As String
sarrtyn = Split(str, "~")
LogID = sarrtyn(1)
firsttime = 1
uname = Sheets(1).txtUsername.Text
Sheets(1).Cells(16, 6) = "Connected"
Sheets(1).ButtonLogin.Caption = "Disconnect"
Call clnt.checkuser(uname, LogID)
isloggedin = 1
CollectAllowedMarkets
'refreshrate = "00:00:04"
'Application.OnTime EarliestTime:=Now + TimeValue(refreshrate),
Procedure:="RefreshValues"
oprprog = 0
Else
Sheets(1).Cells(16, 6) = str
End If
End If
Exit Function
Handler:
End Function
Public Function logout()
If isloggedin = 1 Then
Call clnt.LogoutUser(uname, LogID)
Sheets(1).ButtonLogin.Caption = "Connect"
Sheets(1).Cells(16, 6) = "Not Connected"
uname = ""
isloggedin = 0
Application.DisplayAlerts = False
For i = 2 To Sheets.Count
Sheets(2).Delete
Next
Application.DisplayAlerts = True
End If
End Function
Public Function CollectAllowedMarkets()
allowedMarkets = clnt.allowedMarkets(uname)
alwdmktids = Split(allowedMarkets, "~")
'Old_Mkt_Values = Split(allowedMarkets, "~")
MktCells = alwdmktids
MktCols = alwdmktids
MktNames = alwdmktids
MktTitles = alwdmktids
MktCGreater = alwdmktids
MktCLesser = alwdmktids
MktLimitLess = alwdmktids
MktLimitGreat = alwdmktids
MktLimitEqual = alwdmktids
MktColorLess = alwdmktids
MktColorLess2 = alwdmktids
MktColorGreat = alwdmktids
MktColorEqual = alwdmktids
MktColorString = alwdmktids
MktColorHeader = alwdmktids
MktColorRowHeader = alwdmktids
MktColorColHeader = alwdmktids
MktColorColString = alwdmktids
For i = 0 To UBound(alwdmktids)
Dim str As String
str = clnt.MarketColors(uname, alwdmktids(i))
Dim strarr() As String
strarr = Split(str, "~")
MktCells(i) = strarr(0)
MktCols(i) = strarr(1)
MktNames(i) = strarr(2)
MktTitles(i) = strarr(3)
MktCGreater(i) = strarr(4)
'MsgBox MktCGreater(i)
MktCLesser(i) = strarr(5)
'MsgBox MktCLesser(i)
MktColorGreat(i) = strarr(6)
MktColorLess(i) = strarr(7)
MktColorEqual(i) = strarr(8)
MktColorLess2(i) = strarr(9)
MktColorString(i) = strarr(10)
MktColorHeader(i) = strarr(11)
MktLimitGreat(i) = strarr(12)
MktLimitLess(i) = strarr(13)
MktLimitEqual(i) = strarr(14)
MktColorColHeader(i) = strarr(15)
MktColorRowHeader(i) = strarr(16)
MktColorColString(i) = strarr(17)
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = MktNames(i)
'ActiveSheet.Name = "Sheet" + CStr(i + 8)
Sheets(i + 2).Cells(1, 1) = MktNames(i)
Sheets(i + 2).Cells(3, 1) = "Custom Fields"
Sheets(i + 2).Cells(3, 3) = MktTitles(i)
Dim colcordnates() As String
colcordnates = Split(MktColorHeader(i), "|")
Sheets(i + 2).Cells(3, 3).Interior.Color = RGB(CInt(colcordnates(0)),
CInt(colcordnates(1)), CInt(colcordnates(2)))
With Sheets(i + 2).Range("C3:H3")
.Merge Across:=True
End With
Dim Formuid As Integer
Formuid = ((CInt(alwdmktids(i)) - 1) * 5)
For j = 1 To 5
str = clnt.GetFormula(uname, Formuid + j)
Dim avarSplit() As String
If (str <> "") Then
Dim thecol As String
thecol = ""
avarSplit = Split(str, "~")
For ii = 0 To UBound(avarSplit)
If ii Mod 2 = 0 Then
If InStr(avarSplit(ii), "c") = 0 Then
Dim rownum As Integer
rownum = CInt(avarSplit(ii)) \ CInt(MktCols(i))
rownum = rownum + 4
Dim colnum As Integer
colnum = CInt(avarSplit(ii)) Mod CInt(MktCols(i))
thecol = thecol & Chr(67 + colnum) & CStr(rownum)
Else
thecol = thecol & Mid(avarSplit(ii), 2, Len(avarSplit(ii)))
End If
Else
thecol = thecol & avarSplit(ii)
End If
Next ii
Sheets(i + 2).Cells(j + 3, 1) = "=" & thecol
End If
Next j
Next i
refreshrate = "00:00:02"
conditionsloaded = 0
RefreshValues
End Function
Public Sub CollectConditions()
For ii = 0 To UBound(alwdmktids)
Dim Formuids() As String
Dim formus As String
formus = clnt.GetCustomFormulaIDs(uname, alwdmktids(ii))
If formus <> "" Then
Formuids = Split(formus, "~")
Dim i, j, k As Integer
j = 0
For i = 0 To UBound(Formuids)
formus = clnt.GetCustomFormula(uname, Formuids(i))
Dim TempFOrmu() As String
TempFOrmu = Split(formus, "|")
Dim funparts() As String
funparts = Split(TempFOrmu(0), "~")
Dim tempcondition As String 'this condition would be installed
tempcondition = "=TestExec("
TheConditionString = MktNames(ii) & ": "
For k = 0 To UBound(funparts) 'left side
If InStr(funparts(k), "formu") = 0 Then 'the formula field is
there then false
If k Mod (2) = 1 Then
tempcondition = tempcondition + funparts(k)
TheConditionString = TheConditionString + CStr(k)
Else
TheConditionString = TheConditionString + "cell" + funparts(k)
Dim rownum As Integer
rownum = CInt(funparts(k)) \ CInt(MktCols(ii))
rownum = rownum + 4
Dim colnum As Integer
colnum = CInt(funparts(k)) Mod CInt(MktCols(ii))
tempcondition = tempcondition + Chr(67 + colnum) + CStr(rownum)
End If
Else
Select Case funparts(k)
Case "formu1"
tempcondition = tempcondition + "A4"
TheConditionString = TheConditionString + "Custom 1"
Case "formu2"
tempcondition = tempcondition + "A5"
TheConditionString = TheConditionString + "Custom 2"
Case "formu3"
tempcondition = tempcondition + "A6"
TheConditionString = TheConditionString + "Custom 3"
Case "formu4"
tempcondition = tempcondition + "A7"
TheConditionString = TheConditionString + "Custom 4"
Case Else
tempcondition = tempcondition + "A8"
TheConditionString = TheConditionString + "Custom 5"
End Select
End If
Next 'Left side condition
If TempFOrmu(1) = "==" Then
tempcondition = tempcondition + ", ""="", "
TheConditionString = TheConditionString + " == "
Else
tempcondition = tempcondition + ", """ + TempFOrmu(1) + """, "
TheConditionString = TheConditionString + " " + TempFOrmu(1) + " "
End If 'Condition added
funparts = Split(TempFOrmu(2), "~")
For k = 0 To UBound(funparts) 'right side
If InStr(funparts(k), "formu") = 0 Then 'the formula field is
there then false
If k Mod (2) = 1 Then
tempcondition = tempcondition + funparts(k)
TheConditionString = TheConditionString + funparts(k)
Else
TheConditionString = TheConditionString + "cell" + funparts(k)
rownum = CInt(funparts(k)) \ CInt(MktCols(ii))
rownum = rownum + 4
colnum = CInt(funparts(k)) Mod CInt(MktCols(ii))
tempcondition = tempcondition + Chr(67 + colnum) + CStr(rownum)
End If
Else
Select Case funparts(k)
Case "formu1"
tempcondition = tempcondition + "A4"
TheConditionString = TheConditionString + "Custom 1"
Case "formu2"
tempcondition = tempcondition + "A5"
TheConditionString = TheConditionString + "Custom 2"
Case "formu3"
tempcondition = tempcondition + "A6"
TheConditionString = TheConditionString + "Custom 3"
Case "formu4"
tempcondition = tempcondition + "A7"
TheConditionString = TheConditionString + "Custom 4"
Case Else
tempcondition = tempcondition + "A8"
TheConditionString = TheConditionString + "Custom 5"
End Select
End If
Next 'Right side condition
'check if the condition is already executing
If IsEmpty(ConExecting) Then
ReDim ConExecting(0) As Integer
ReDim Cond_with_Market(0) As String
ConExecting(UBound(ConExecting)) = 0
Cond_with_Market(UBound(Cond_with_Market)) = TheConditionString
Else
ReDim Preserve ConExecting(UBound(ConExecting) + 1)
ReDim Preserve Cond_with_Market(UBound(Cond_with_Market) + 1)
ConExecting(UBound(ConExecting)) = 0
Cond_with_Market(UBound(Cond_with_Market)) = TheConditionString
End If
tempcondition = tempcondition + ", """ + TempFOrmu(3) + """, """
+ Formuids(i) + """," + CStr(4 + j) + ", " + CStr(ii + 2) + ", " +
CStr(UBound(ConExecting)) + ", "" " + TempFOrmu(4) + " """ + ")"
'tempcondition = tempcondition + ", """ + TempFOrmu(3) + """,
""" + Formuids(i) + """," + CStr(4 + j) + ", " + CStr(ii + 2) + ", " +
CStr(UBound(ConExecting)) + ")"
Sheets(ii + 2).Cells(4 + j, 2) = tempcondition
tempcondition = ""
j = j + 1
Next i
End If
Next ii
Exit Sub
End Sub
Public Sub RefreshValues()
On Error GoTo Handler
MousePointer = vbNormal
If Sheets(1).ButtonLogin.Caption <> "Connect" Then
Dim colcordnates() As String
For i = 0 To UBound(alwdmktids)
Dim str As String
str = clnt.CollectInfoMarketNew(uname, alwdmktids(i), LogID)
'If Not Old_Mkt_Values(i) = str Then
'Old_Mkt_Values(i) = str
Dim avarSplit() As String
avarSplit = Split(str, "~")
Dim ii, j, k As Integer
j = 6
k = 0
Dim totrows As Integer
totrows = CInt(MktCells(i)) \ CInt(MktCols(i))
If UBound(avarSplit) + 1 >= CInt(MktCells(i)) Then
For ii = 0 To totrows - 1
For j = 0 To CInt(MktCols(i)) - 1
If IsNumeric(avarSplit(k)) And avarSplit(k) <> "" Then
If CheckValueOp(Sheets(i + 2).Cells(ii + 4, j + 3),
MktLimitLess(i), ">=") Then
colcordnates = Split(MktColorLess(i), "|")
Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color =
RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
End If
If CheckValueOp(Sheets(i + 2).Cells(ii + 4, j + 3),
MktLimitEqual(i), ">=") Then
colcordnates = Split(MktColorEqual(i), "|")
Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color =
RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
End If
If CheckValueOp(Sheets(i + 2).Cells(ii + 4, j + 3),
MktLimitGreat(i), ">=") Then
colcordnates = Split(MktColorGreat(i), "|")
Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color =
RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
End If
If CheckValueOp(Sheets(i + 2).Cells(ii + 4, j + 3),
MktLimitLess(i), "<") Then
colcordnates = Split(MktColorLess2(i), "|")
Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color =
RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
End If
If Sheets(i + 2).Cells(ii + 4, j + 3) <>
avarSplit(k) Then
If chkLess(Sheets(i + 2).Cells(ii + 4, j + 3),
avarSplit(k)) Then
colcordnates = Split(MktCGreater(i), "|")
Sheets(i + 2).Cells(ii + 4, j +
3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)),
CInt(colcordnates(2)))
Else
colcordnates = Split(MktCLesser(i), "|")
Sheets(i + 2).Cells(ii + 4, j +
3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)),
CInt(colcordnates(2)))
End If
Sheets(i + 2).Cells(ii + 4, j + 3) = avarSplit(k)
End If
Else
If avarSplit(k) = "" Then
Sheets(i + 2).Cells(ii + 4, j +
3).Interior.Color = RGB(255, 255, 255)
Sheets(i + 2).Cells(ii + 4, j + 3) = avarSplit(k)
Else
colcordnates = Split(MktColorString(i), "|")
Sheets(i + 2).Cells(ii + 4, j +
3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)),
CInt(colcordnates(2)))
Sheets(i + 2).Cells(ii + 4, j + 3) = avarSplit(k)
End If
End If
If k Mod CInt(MktCols(i)) = 0 Then
colcordnates = Split(MktColorRowHeader(i), "|")
Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color =
RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
End If
If k < CInt(MktCols(i)) Then
colcordnates = Split(MktColorColHeader(i), "|")
Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color =
RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
End If
If avarSplit(k) = "" Then
colcordnates = Split(MktColorColString(i), "|")
Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color =
RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
End If
k = k + 1
Next j
Next ii
End If
'End If
Next i
If conditionsloaded = 1 Then
Application.OnTime EarliestTime:=Now + TimeValue(refreshrate),
Procedure:="RefreshValues"
Else
If firsttime = 1 Then
CollectConditions
Application.OnTime EarliestTime:=Now + TimeValue(refreshrate),
Procedure:="RefreshValues"
conditionsloaded = 1
Else
Sheets(delsheetid).Cells(delsheetcell, 2) = ""
Application.OnTime EarliestTime:=Now + TimeValue(refreshrate),
Procedure:="RefreshValues"
conditionsloaded = 1
firsttime = 1
End If
End If
End If
Exit Sub
Handler:
Application.OnTime EarliestTime:=Now + TimeValue(refreshrate),
Procedure:="RefreshValues"
Exit Sub
End Sub
Public Function TestExec(lftsde, cditon, rhtsde, opration, Formuid,
ClearCellid, ClearSheetid, FormulaIndex, cond_text_sp)
TestExec = "Alert Not Triggered"
If Evaluate(lftsde & cditon & rhtsde) Then
If ConExecting(FormulaIndex) = 0 Then
If opration = "1" Then
Call clnt.SendAlert(uname, Cond_with_Market(FormulaIndex),
Formuid)
TestExec = "Alert Triggered"
Else
If conditions_are_true = 0 Then
Call sndPlaySound32("C:\Program Files\Signal System
Client\success.wav", SND_ASYNC + SND_LOOP)
End If
conditions_are_true = conditions_are_true + 1
If opration = "2" Then
Call clnt.Event_Log(uname, Cond_with_Market(FormulaIndex),
"", "Play alarm")
Else
Call clnt.Event_Log(uname, Cond_with_Market(FormulaIndex),
cond_text_sp, "Timer")
End If
TestExec = "Alert Triggered"
End If 'the condition whether operation is 1 or other
ConExecting(FormulaIndex) = 1
Else
If opration <> "1" Then
'Call sndPlaySound32("C:\Program Files\Signal System
Client\success.wav", SND_ASYNC + SND_LOOP)
TestExec = "Alert Triggered"
End If
End If 'already executing operation or not
Else
If ConExecting(FormulaIndex) = 1 Then
ConExecting(FormulaIndex) = 0
conditions_are_true = conditions_are_true - 1
If conditions_are_true = 0 Then
Call sndPlaySound32("C:\Program Files\Signal System
Client\none.wav", 1)
End If
End If
End If 'end of evaluation
End Function
Public Function CheckValueOp(leftvalue, rightvalue, compoperator) As
Boolean
On Error GoTo Handler
If compoperator = "==" Then
If CDbl(leftvalue) = CDbl(rightvalue) Then
CheckValueOp = True
Else
CheckValueOp = False
End If
Exit Function
End If
If compoperator = "<" Then
If CDbl(leftvalue) < CDbl(rightvalue) Then
CheckValueOp = True
Else
CheckValueOp = False
End If
Exit Function
End If
If compoperator = ">=" Then
If CDbl(leftvalue) >= CDbl(rightvalue) Then
CheckValueOp = True
Else
CheckValueOp = False
End If
Exit Function
End If
Handler:
CheckValueOp = False
End Function
Public Function chkLess(frstvalu, scndvalu) As Boolean
On Error GoTo Handler
If CDbl(frstvalu) < CDbl(scndvalu) Then
chkLess = True
Else
chkLess = False
End If
Exit Function
Handler:
chkLess = False
End Function