visual studio vers VBA

Version imprimable

j'ai besoin de ces fonctions sous vba , pouvez vous corriger les problèmes de compilation car je suis un débutant. Merci

Code:

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
Function ch(ByRef x As Double) 'définition de la fonction cosinus hyperbolique Dimt AsDouble
 
t = (Exp(x) + Exp(-x)) / 2
ch = t
End Function
 
Function Sh(ByRef x As Double) 'définition de la fonction sinus hyperbolique Dimt AsDouble
 
t = (Exp(x) - Exp(-x)) / 2
Sh = t
End Function
 
Function Gp(ByRef a As Double, ByRef b As Double, ByRef c As Double, ByRef n As Double) 'aide de calcul Dimt AsDouble
 
t = ((1 - n) * a * ch(a) - (1 + n) * Sh(a)) * ch(b * c) - (1 - n) * Sh(a) * Sh(b * c) * b * c
Gp = t
End Function
 
Function Gq(ByRef a As Double, ByRef b As Double, ByRef c As Double, ByRef n As Double) 'aide de calcul Dimt AsDouble
t = (2 * Sh(a) + (1 - n) * a * ch(a)) * Sh(b * c) - (1 - n) * Sh(a) * ch(b * c) * b * c
Gq = t
End Function
 
 
Function Valeure(ByRef b() As Double)
Dim v As newarraylist
Dim i As Integer
For i = 0 To 250
v.Add = (-((250 - i) * b) / 250)
Next
For i = 1 To 250
v.Add = ((i * b) / 250)
Next
Valeure = v
End Function
 
Function Valeurk(ByRef alpha As Double, ByRef b As Double, ByRef Theta As Double, ByRef y As Double)
Dim v As newarraylist
For i = 0 To 500
v.Add (fk(alpha, FK0(b, Theta, y, Valeure(b)(i)), FK1(b, Theta, y, Valeure(b)(i))))
Next
Valeurk = v
End Function
 
Function fk(ByRef alpha As Double, ByRef k0 As Double, ByRef k1 As Double)
 
Dim t As Double
t = k0 + (k1 - k0) * (alpha) ^ (0.5)
fk = t
End Function
 
Function FK0(ByRef b As Double, ByVal Theta As Double, ByVal y As Double, ByVal e As Double)   'Calcul de Ko (Alpha=0)
 
Dim Signe As Integer
Dim aa, ab, ac, ae, af, ag, ah, dlb, Lby, Lbe, Lbem, Lambda As Double
Dim t As Double
Lambda = Theta * Pi / b / 2 ^ (0.5)
 
Signe = 1
If e < y Then
Signe = -1
End If
Lby = Lambda * (b + Signe * y)
Lbe = Lambda * (b + Signe * e)
Lbem = Lambda * (b - Signe * e)
dlb = 2 * Lambda * b
ag = Sh(dlb)
aa = dlb / (Pow(Sh(dlb), 2) - Pow(Sin(dlb), 2))
ab = 2 * ch(Lby) * Cos(Lby)
ac = Sh(dlb) * Cos(Lbe) * ch(Lbem) - Sin(dlb) * ch(Lbe) * Cos(Lbem)
ae = ch(Lby) * Sin(Lby) + Sh(Lby) * Cos(Lby)
af = Sin(Lbe) * ch(Lbem) - Cos(Lbe) * Sh(Lbem)
ah = Sh(Lbe) * Cos(Lbem) - ch(Lbe) * Sin(Lbem)
t = aa * (ab * ac + ae * (ag * af + Sin(dlb) * ah))
FK0 = t
End Function
 
 
Function FK1(ByRef b As Double, ByRef Theta As Double, ByRef y As Double, ByRef e As Double)   'Calcul de K1 (Alpha=1)
 
End Function
Dim Beta, Lambda, Sigma, aek, afk, agk As Double
Dim ShSigma, ChSigma, Phi, Khi As Double
Dim aak, abk, ack, adk As Double
Dim t As Double
Sigma = Theta * Pi
Beta = Pi * y / b
Lambda = Theta * Pi / b / 2 ^ (0.5)
ShSigma = Sh(Sigma)
ChSigma = ch(Sigma)
aek = Gp(Sigma, Theta, Beta, 0) / (3 * ShSigma * ChSigma - Sigma)
afk = Gq(Sigma, Theta, Beta, 0) / (3 * ShSigma * ChSigma + Sigma)
agk = Sigma / (2 * Pow(ShSigma, 2))
Phi = Pi * e / b
Khi = Pi - Abs(Beta - Phi)
aak = (Sigma * ChSigma + ShSigma) * ch(Theta * Khi)
abk = Theta * Khi * ShSigma * Sh(Theta * Khi)
ack = Gp(Sigma, Theta, Phi, 0)
adk = Gq(Sigma, Theta, Phi, 0)
t = agk * (aak - abk + ack * aek + adk * afk)
FK1 = t
End Function

02/12/2015, 21h58
parmi

Bonjour,

Premièrement, quand tu mets du code, sélectionne-le et clique le bouton # dans la barre d'outil du message.
Maintenant, tu dis avoir des erreurs: Il faudrait savoir où apparaissent les erreurs (ligne) et quel message tu reçois...
02/12/2015, 23h02
kiki29

Salut, 2 fois valent mieux q'une : Balise ton code

Bonjour,

Pour déclarer une fonction devant retourner un tableau, il faut procéder de cette façon : "Function Valeure(ByRef b As Double) As Double()" :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Function Valeure(ByRef b As Double) As Double()
 
    Dim v(0 To 250) As Double
    Dim I As Integer
 
    For I = 0 To 250
        v(I) = (-((250 - I) * b) / 250)
    Next
 
    'les calculs précédents sont remplacés par ceux-ci donc c'est quoi l'intérêt de la première boucle ?
    For I = 1 To 250
        v(I) = ((I * b) / 250)
    Next
 
    Valeure = v()
 
End Function

par contre, je ne vois pas l'intérêt de ces deux boucles, la seconde écrasant la première. Ont procède de cette façon quand on veut utiliser les résultats de la première dans la seconde ce qui n'est pas le cas ici !
Il te faut déclarer une variable tableau dans la fonction :

Code:

1
2
 
Dim v(0 To 250) As Double

Que tu dimensionnes en "dur" ou dynamiquement dans le développement du code.
Tu appelles ta fonction de cette façon :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Sub Test()
 
    Dim Tbl() As Double
    Dim I As Integer
 
    Tbl = Valeure(10)
 
    For I = 0 To UBound(Tbl)
        Debug.Print Tbl(I)
    Next I
 
End Sub

Quand tu déclares des variables de cette façon :

Code:

1
2
 
Dim aa, ab, ac, ae, af, ag, ah, dlb, Lby, Lbe, Lbem, Lambda As Double

seule la variable "Lambda" est de type Double, les autres ayant le type par défaut "Variant". Il est préférable de les déclarer en les typant toutes :

Code:

1
2
3
4
5
 
Dim aa As Double, ab As Double, ac As Double, ae As Double
Dim af As Double, ag As Double, ah As Double, dlb As Double
Dim Lby As Double, Lbe As Double, Lbem As Double, Lambda As Double
Dim t As Double

La fonction Pow n'existe pas en VBA mais tu peux procéder de deux autres façons, soit avec "WorksheetFunction.Power" (fonction "Puissance" d'Excel) soit avec le signe "^" :

Code:

1
2
3
 
aa = dlb / (WorksheetFunction.Power(Sh(dlb), 2) - WorksheetFunction.Power(Sin(dlb), 2))
aa = dlb / (Sh(dlb) ^ 2 - Sin(dlb) ^ 2)

Il en est de même pour Pi :

Code:

1
2
3
4
5
6
 
'soit...
Const Pi As Single = 3.14159265358979
'soit...
Dim Pi As Single
Pi = WorksheetFunction.Pi

Ta fonction devient :

Code:

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
 
Function FK0(ByRef b As Double, ByVal Theta As Double, ByVal y As Double, ByVal e As Double) 'Calcul de Ko (Alpha=0)
 
    Dim Signe As Integer
    Dim aa As Double, ab As Double, ac As Double, ae As Double
    Dim af As Double, ag As Double, ah As Double, dlb As Double
    Dim Lby As Double, Lbe As Double, Lbem As Double, Lambda As Double
    Dim t As Double
    Dim Pi As Single
 
    Pi = WorksheetFunction.Pi
 
    Lambda = Theta * Pi / b / 2 ^ (0.5)
 
    If e < y Then Signe = -1 Else Signe = 1
 
    Lby = Lambda * (b + Signe * y)
    Lbe = Lambda * (b + Signe * e)
    Lbem = Lambda * (b - Signe * e)
    dlb = 2 * Lambda * b
    ag = Sh(dlb)
    aa = dlb / (Sh(dlb) ^ 2 - Sin(dlb) ^ 2)
    ab = 2 * ch(Lby) * Cos(Lby)
    ac = Sh(dlb) * Cos(Lbe) * ch(Lbem) - Sin(dlb) * ch(Lbe) * Cos(Lbem)
    ae = ch(Lby) * Sin(Lby) + Sh(Lby) * Cos(Lby)
    af = Sin(Lbe) * ch(Lbem) - Cos(Lbe) * Sh(Lbem)
    ah = Sh(Lbe) * Cos(Lbem) - ch(Lbe) * Sin(Lbem)
    t = aa * (ab * ac + ae * (ag * af + Sin(dlb) * ah))
 
    FK0 = t
 
End Function

et la dernière :

Code:

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
 
Function FK1(ByRef b As Double, ByRef Theta As Double, ByRef y As Double, ByRef e As Double) 'Calcul de K1 (Alpha=1)
 
    Dim Beta As Double, Lambda As Double, Sigma As Double, aek As Double, afk As Double, agk As Double
    Dim ShSigma As Double, ChSigma As Double, Phi As Double, Khi As Double
    Dim aak As Double, abk As Double, ack As Double, adk As Double
    Dim t As Double
    Dim Pi As Single
 
    Pi = WorksheetFunction.Pi
 
    Sigma = Theta * Pi
    Beta = Pi * y / b
    Lambda = Theta * Pi / b / 2 ^ (0.5)
    ShSigma = Sh(Sigma)
    ChSigma = ch(Sigma)
    aek = Gp(Sigma, Theta, Beta, 0) / (3 * ShSigma * ChSigma - Sigma)
    afk = Gq(Sigma, Theta, Beta, 0) / (3 * ShSigma * ChSigma + Sigma)
    agk = Sigma / (2 * ShSigma ^ 2)
    Phi = Pi * e / b
    Khi = Pi - Abs(Beta - Phi)
    aak = (Sigma * ChSigma + ShSigma) * ch(Theta * Khi)
    abk = Theta * Khi * ShSigma * Sh(Theta * Khi)
    ack = Gp(Sigma, Theta, Phi, 0)
    adk = Gq(Sigma, Theta, Phi, 0)
    t = agk * (aak - abk + ack * aek + adk * afk)
    FK1 = t
 
End Function