Nouvelle erreur Type Mismatch

**DonaldTron** · 14/11/2007, 12h21

Bonjour,

j'ai de nouveau un problème avec les types de variables Double... Comme je l'ai expliqué sur une précédente file, j'avais un code de départ avec une simple inégalité qui fonctionnait très bien avec des variables string. Seulement, je dois ici effectuer une division et on m'a expliqué que je devais utiliser des variables Double pour effectuer ma division. Seulement, maintenant le problème se situe au niveau de la définition de la variable " BidPriceBis" et surement aussi pour " AskPriceBis".

Les nombres contenues dans les cellules de la worksheet "Tickers" sont à 2 décimales, mais avec une seule décimale si la deuxième avait été 0.

Voici mon code. Est-ce que vous pourriez m'aider? J'ai vraiment du mal avec VBA pour l'instant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
 
 
Option Explicit
Dim lastId As Long
Dim offset As Long
Public runWhen As Double
Public Const RUN_INTERVAL_SECONDS = 1
Public Const CapitalAmount = 10000
Public Const ProfitBarrier = 20
Public Const RUN_WHAT = "Example1.ArbSearch"
Public Const OppLim = 0.05
 
 
 
Sub ArbSearch()
    Dim symbol As String
    Dim SecType As String
    Dim Exchange As String
    Dim BidPrice As Double
    Dim AskPrice As Double
    Dim BidPriceBis As Double
    Dim AskPriceBis As Double
    Dim logSuccess As Boolean
    Dim TickerRow As Integer
    Dim NumShares As Double
 
    For TickerRow = 8 To 87
 
        symbol = UCase(Worksheets("Tickers").Cells(TickerRow, 1).value)
        SecType = UCase(Worksheets("Tickers").Cells(TickerRow, 2).value)
        Exchange = UCase(Worksheets("Tickers").Cells(TickerRow, 7).value)
        BidPrice = CDbl(Worksheets("Tickers").Cells(TickerRow, 15).value)
        AskPrice = CDbl(Worksheets("Tickers").Cells(TickerRow, 16).value)
        BidPriceBis = CDbl(Worksheets("Tickers").Cells(TickerRow + 1, 15).value)
        AskPriceBis = CDbl(Worksheets("Tickers").Cells(TickerRow + 1, 16).value)
        NumShares = CapitalAmount / AskPriceBis
 
        If symbol = UCase(Worksheets("Tickers").Cells(TickerRow + 1, 1).value) And Exchange <> UCase(Worksheets("Tickers").Cells(TickerRow + 1, 7).value) Then
                If (BidPriceBis - AskPrice) * NumShares > ProfitBarrier Or (BidPrice - AskPriceBis) * NumShares > ProfitBarrier Then
        MsgBox symbol
        MsgBox BidPrice
        MsgBox AskPrice
        MsgBox BidPriceBis
        MsgBox AskPriceBis
        End If
    End If
 
    Next TickerRow
 
    startTimer ' schedule next run
End Sub
 
Sub startTimer()
    runWhen = Now + TimeSerial(0, 0, RUN_INTERVAL_SECONDS)
    Worksheets("Auto Orders").Range("X3").value = Format(runWhen, "yyyy-mm-dd hh:mm")
    Application.OnTime earliesttime:=runWhen, procedure:=RUN_WHAT, schedule:=True
End Sub
 
Sub stopTimer()
   On Error Resume Next
   Application.OnTime earliesttime:=runWhen, procedure:=RUN_WHAT, schedule:=False
   Worksheets("Auto Orders").Range("X3").value = "Stopped"
End Sub

Merci d'avance.

**ouskel'n'or** · 14/11/2007, 19h18

1 - Qu'as-tu comme séparateur décimal
2 - Comment les données BidPriceBis et AskPriceBis ont-elles été insérées dans les cellules (copie de puis autre fichier ? Saisie manuelle ? ...)

**DonaldTron** · 14/11/2007, 19h30

Merci de ta réponse.

Mon séparateur décimal est le point.

Les données de la worksheets "tickers" viennent d'un lien DDE avec les datas de mon courtier( c'est une macro boursière ). Ce n'est pas moi qui l'ai réalisée.
Voici le code qui permet d'obtenir les datas dans cette worksheet:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
 
Option Explicit
 
Dim genId As Integer
 
Const serverCell = "tickerServer"
Const refreshRateCell = "refreshRate"
Const refreshRateLink = "refreshRateLink"
Const processingRateCell = "processingRate"
Const processingRateLink = "processingRateLink"
Const logLevelCell = "logLevel"
Const logLevelResult = "logLevelResult"
Const topic = "tik"
Const bulletinTopic = "news"
Const reqOffset = 10
Const errorRange = "tickerErrorPosition"
Const tickerCells = "tickerCells"
Const bulletinCtrl = "bulletinCtrl"
Const bulletinCell = "bulletinCell"
Const bulletinTitle = "bulletinTitle"
 
Sub requestMarketData()
    Dim server As String, req As String, reqType As String, id As String, SecType As String
    server = util.getServerStr(serverCell)
    If server = "" Then Exit Sub
    If Not util.composeContractReq(ActiveCell, req, reqType, True) Then Exit Sub
    id = util.getIDpost(genId)
 
    ActiveCell.offset(0, reqOffset).Formula = util.composeControlLink(server, topic, id, reqType, req)
    ActiveCell.offset(0, reqOffset + 3).Formula = util.composeLink(server, topic, id, "bidSize")
    ActiveCell.offset(0, reqOffset + 4).Formula = util.composeLink(server, topic, id, "bid")
    ActiveCell.offset(0, reqOffset + 5).Formula = util.composeLink(server, topic, id, "ask")
    ActiveCell.offset(0, reqOffset + 6).Formula = util.composeLink(server, topic, id, "askSize")
    ActiveCell.offset(0, reqOffset + 9).Formula = util.composeLink(server, topic, id, "last")
    ActiveCell.offset(0, reqOffset + 10).Formula = util.composeLink(server, topic, id, "lastSize")
    ActiveCell.offset(0, reqOffset + 13).Formula = util.composeLink(server, topic, id, "high")
    ActiveCell.offset(0, reqOffset + 14).Formula = util.composeLink(server, topic, id, "low")
    ActiveCell.offset(0, reqOffset + 15).Formula = util.composeLink(server, topic, id, "volume")
    ActiveCell.offset(0, reqOffset + 16).Formula = util.composeLink(server, topic, id, "close")
 
    SecType = UCase(ActiveCell.offset(0, 1).value)
    If SecType = util.OPT Or SecType = util.FOP Then
        ActiveCell.offset(0, reqOffset + 1).Formula = util.composeLink(server, topic, id, "bidImpliedVol")
        ActiveCell.offset(0, reqOffset + 2).Formula = util.composeLink(server, topic, id, "bidDelta")
        ActiveCell.offset(0, reqOffset + 7).Formula = util.composeLink(server, topic, id, "askImpliedVol")
        ActiveCell.offset(0, reqOffset + 8).Formula = util.composeLink(server, topic, id, "askDelta")
        ActiveCell.offset(0, reqOffset + 11).Formula = util.composeLink(server, topic, id, "lastImpliedVol")
        ActiveCell.offset(0, reqOffset + 12).Formula = util.composeLink(server, topic, id, "lastDelta")
        ActiveCell.offset(0, reqOffset + 17).Formula = util.composeLink(server, topic, id, "modelVolatility")
        ActiveCell.offset(0, reqOffset + 18).Formula = util.composeLink(server, topic, id, "modelDelta")
        ActiveCell.offset(0, reqOffset + 19).Formula = util.composeLink(server, topic, id, "modelPrice")
        ActiveCell.offset(0, reqOffset + 20).Formula = util.composeLink(server, topic, id, "pvDividend")
    End If
 
    ActiveCell.offset(1, 0).Activate
End Sub
Sub setRefreshRate()
    Dim theRate As String
    theRate = Range(refreshRateCell).value
    If theRate = "" Then
        MsgBox ("You must enter a valid refresh rate.")
        Exit Sub
    End If
    Range(refreshRateLink).value = getServerStr(serverCell) & "refreshRate!millisec?" & theRate
End Sub
Sub setProcessingRate()
    Dim theRate As String
    theRate = Range(processingRateCell).value
    If theRate = "" Then
        MsgBox ("You must enter a valid processing rate.")
        Exit Sub
    End If
    Range(processingRateLink).value = getServerStr(serverCell) & "processRate!millisec?" & theRate
End Sub
Sub newBulletins()
    IBBulletinsForm.Show
End Sub
Sub setLoggingLevel()
    Dim logLevel As String
    logLevel = Range(logLevelCell).value
    If logLevel = "" Then
        MsgBox ("You must enter a valid log level (1-5).")
        Exit Sub
    End If
    Range(logLevelResult).value = getServerStr(serverCell) & "logLevel!'0" & logLevel & "'"
End Sub
Sub onShowError()
    Call showLastError(serverCell, errorRange)
End Sub
Sub bulletinDeSubscribe()
    doBulletinArea (False)
    IBBulletinsForm.Hide
End Sub
Sub bulletinSubscribe()
    Dim newReqStr, server As String
 
    server = getServerStr(serverCell)
    If server = "" Then Exit Sub
 
    doBulletinArea (True)
    Range(bulletinCell).offset(-1, 0).Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "IB News Bulletins"
    Range(bulletinCtrl).value = util.composeSubscriptionLink(server, bulletinTopic, util.BULLETIN_REQ)
    Range(bulletinCell).value = server & "news!msg"
    ' The following  data is also available if required
    'Cells(Y, X).Value = serverStr & "news!newsId"
    'Cells(Y, X).Value = serverStr & "news!newsType"
    'Cells(Y, X).Value = serverStr & "news!exchange"
 
    IBBulletinsForm.Hide
End Sub
Sub doBulletinArea(ByVal subscribing As Boolean)
    Range(bulletinCell).Select
    With Selection.Interior
        .colorIndex = util.brightRedColorIndex
        .Pattern = xlSolid
    End With
 
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .colorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .colorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .colorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .colorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub
Sub clearLinks()
    Call clearErrorDisplay(errorRange)
    Call util.clearRange(tickerCells, util.darkGreyColorIndex, xlShiftUp)
    Call util.clearRange(refreshRateLink)
    Call util.clearRange(logLevelResult)
    Call util.clearRange(bulletinCtrl)
    Call util.clearRange(bulletinCell)
    Call util.clearRange(bulletinTitle)
    Call util.clearRange(processingRateLink)
End Sub

**ouskel'n'or** · 14/11/2007, 23h29

Ok, alors tu dois remplacer le séparateur décimal par une virgule sinon Excel considère ton nombre comme un string
Tu sélectionnes ta colonne et tu remplaces les points par des virgules.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
NoCol = 3 ' à adapter
Columns(NoCol).Replace What:=".", Replacement:=",", LookAt:=xlPart

**ouskel'n'or** · 14/11/2007, 23h46

Tu peux toujours tester ça ligne par ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
        BidPrice = CDbl(Replace(Worksheets("Tickers").Cells(TickerRow, 15).value), ".", ",")
        AskPrice = CDbl(Replace(Worksheets("Tickers").Cells(TickerRow, 16).value), ".", ",")
        BidPriceBis = CDbl(Replace(Worksheets("Tickers").Cells(TickerRow + 1, 15).value), ".", ",")
        AskPriceBis = CDbl(Replace(Worksheets("Tickers").Cells(TickerRow + 1, 16).value), ".", ",")

Mais à ta place, je traiterais les différentes colonnes concernées en une seule fois.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("O:P").Replace What:=".", Replacement:=",", LookAt:=xlPart

**DonaldTron** · 15/11/2007, 07h37

Merci beaucoup.Je vais essayer et je vous tiens au courant.

Nouvelle erreur Type Mismatch

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager