Bonjour le forum,
Je n’ai pas trouvé sur le net une calculatrice scientifique en VBA, et comme je n’avais rien à faire ce Week end (sic).
Le but étant :
Lorsqu’on double clique sur un TextBox on affiche dans l’Usf une calculatrice.
On effectue le calcul et le résultat est renvoyé dans le TextBox double cliqué.
Elle est donc dans une frame.
Chaque touche est composée de 3 images de façon à recréer un effet visuel.
Les images sont gérer par un module de classe.
Cette calculette est basée sur la méthode Evaluate de VBA.
Elle peut effectuer un calcul à partir d’une formule saisie dans un TextBox.
Volontairement le TextBox contenant la formule est en Locked = True pour éviter le renvoi du clavier.
Le curseur du TextBox peut être déplacé (SelStart) afin insérer ou supprimer des caractères.
Afin de pouvoir travailler en degré et donc pouvoir convertir en radians, dans les fonctions trigonométrique, Sinus, Cosinus et Tangente, les valeurs angulaires doivent être entre crochets « [] ». On peut donc avoir des formules du type Sin (45*(2+5))
Elle possède :
Trois mémoires (formule et résultat)
Et un compteur de parenthèses et de crochets afin d’informer de l’état de fermeture de ceux ci.
Le plus délicat ne fut pas le résultat mathématique par lui-même, mais la gestion du visuel et du curseur (correction de la formule avec les suppressions et les insertions)
Voici le code du module de classe pour la gestion des touches
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
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
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
| Option Explicit
Public WithEvents ClasImgCalculette As MSForms.Image
Dim LeTag As Variant
Dim TagTch As Byte
Dim CompCal As Byte
Dim Debut As String
Dim Fin As String
'------------------------------------------------------------------------------------------------
' Chaque touche de la calculette est composée de 3 images
' La première est la touche normalement visible
' La seconde apparait lorsque la souris survole la première
' La troisième apparait lorsque l'on Click sur la seconde
' Leur Tag est le nom de l'image
' Il est défini de la façon suivante :
' La Racine : Tch, CrCal, InfoCal pour différencier les actions a mener
' l'indice qui est composé de :
' 1, 2 ou 3 (1 pour image normale, 2 pour l'image appelante, 3 pour l'image cliquée
' suivi du chrono 1,2,3, .......
' La Racine et l'indice sont séparés par "_"
' pour les croix et l'info 2 images suffisent
'------------------------------------------------------------------------------------------------
Private Sub ClasImgCalculette_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
LeTag = Split(ClasImgCalculette.Tag, "_")(1)
With UserForm1
Select Case Split(ClasImgCalculette.Tag, "_")(0) ' test sur la racine
' Gestion des Touches
Case "Tch"
TagTch = Right(LeTag, Len(LeTag) - 1) ' prend le premier chiffre de l'indice
If Left(LeTag, 1) = 1 Then
For CompCal = 0 To 45 ' remet touche les touches en position normale
.Controls("Tch_1" & CompCal).Visible = True ' affiche les touches normales
.Controls("Tch_2" & CompCal).Visible = False ' cache les touches appelantes
Next CompCal
.Controls("Tch_1" & TagTch).Visible = False ' rends invisible la première image
.Controls("Tch_2" & TagTch).Visible = True ' fait apparaitre la seconde
End If
' Gestion des Croix
Case "CrCal"
.Controls("CrCal_1").Visible = False ' cache la croix normale
.Controls("CrCal_2").Visible = True ' affiche la croix appelante
' Gestion des images info
Case "InfoCal"
.Controls("InfoCal_1").Visible = False ' cache l'info normale
.Controls("InfoCal_2").Visible = True ' affiche l'info appelante
.LibInfo.Visible = True ' Affiche l'info
End Select
End With
End Sub
Private Sub ClasImgCalculette_Click()
Dim PauseTime As Single
Dim Start As Date
Dim Resul As Double
PauseTime = 0.1 ' Définit la durée.
Start = Timer ' Définit l'heure de début.
LeTag = Split(ClasImgCalculette.Tag, "_")(1)
With UserForm1
Select Case Split(ClasImgCalculette.Tag, "_")(0) ' test sur la racine
Case "Tch" ' Gestion des Touches
TagTch = Right(LeTag, Len(LeTag) - 1) ' prend le premier chiffre de l'indice
If IsNumeric(.Resultat.Caption) Then Resul = .Resultat.Caption
If LeTag < 241 Then .Resultat.Caption = ""
If Left(LeTag, 1) = 2 Then
.Controls("Tch_2" & TagTch).Visible = False
.Controls("Tch_3" & TagTch).Visible = True
' le Timer est nécessaire pour l'effet du Click
Do While Timer < Start + PauseTime
DoEvents ' Donne le contrôle à d'autres processus.
Loop
' Test l'indice pour les actions à mener
Select Case LeTag
' Touche numérique 0 à 9
Case Is < 210
Call Procedure02(CStr(TagTch))
' le séparateur décimale "."
Case 210
Call Procedure02(".")
' l'opérateur "-"
Case 211
Call Procedure02("-")
' l'opérateur "+"
Case 212
Call Procedure02("+")
' l'opérateur "*"
Case 213
Call Procedure02("*")
' l'opérateur "/"
Case 214
Call Procedure02("/")
' l'ouverture des parenthèses "("
Case 215
.CompP_3.Caption = .CompP_3.Caption + 1
Call Procedure02("(")
' la fermeture des parenthèses ")"
Case 216
.CompP_4.Caption = .CompP_4.Caption + 1
If LesParentheses(1) = True Then GoTo EndSelect: ' test sur les parenthèses si True on sort
Call Procedure02(")")
' l'ouverture des crochets "[", les valeurs angulaires seront entre [ ]
Case 217
.CompP_1.Caption = .CompP_1.Caption + 1
Call Procedure02("[")
' la fermeture des crochets "]"
Case 218
.CompP_2.Caption = .CompP_2.Caption + 1
If LesParentheses(2) = True Then GoTo EndSelect: ' test sur les parenthèses si True on sort
Call Procedure02("]")
' la constante Pi "Pi"
Case 219
Call Procedure02("Pi")
' le Sinus "Sin(["
Case 220
Call Procedure02("Sin([")
.CompP_1.Caption = .CompP_1.Caption + 1
.CompP_3.Caption = .CompP_3.Caption + 1
' le Cosinus "Cos(["
Case 221
Call Procedure02("Cos([")
.CompP_1.Caption = .CompP_1.Caption + 1
.CompP_3.Caption = .CompP_3.Caption + 1
' la Tangente "Tan(["
Case 222
Call Procedure02("Tan([")
.CompP_1.Caption = .CompP_1.Caption + 1
.CompP_3.Caption = .CompP_3.Caption + 1
' l'Arc Sinus "Asin("
Case 223
Call Procedure02("Asin(")
.CompP_3.Caption = .CompP_3.Caption + 1
' l'Arc Cosinus "Acos("
Case 224
Call Procedure02("Acos(")
.CompP_3.Caption = .CompP_3.Caption + 1
' l'Arc Tangente "Atan("
Case 225
Call Procedure02("Atan(")
.CompP_3.Caption = .CompP_3.Caption + 1
' la puissance y "^"
Case 226
Call Procedure02("^")
' la racine carré "Sqrt("
Case 227
Call Procedure02("Sqrt(")
.CompP_3.Caption = .CompP_3.Caption + 1
' la puissance 2 "^2"
Case 228
Call Procedure02("^2")
' logarithme base 10 "Log("
Case 229
Call Procedure02("Log(")
.CompP_3.Caption = .CompP_3.Caption + 1
' logarithme népérien "Ln("
Case 230
Call Procedure02("Ln(")
.CompP_3.Caption = .CompP_3.Caption + 1
' efface les caractères de la formule à partir de la droite
Case 231
' coupe la formule a l'aide de .SelStart
Debut = Mid(.Fenetre.Value, 1, .Fenetre.SelStart)
Fin = Mid(.Fenetre.Value, .Fenetre.SelStart + 1, Len(.Fenetre.Value))
' décrémente les compteurs
If Right(Debut, 1) = "[" Then .CompP_1.Caption = .CompP_1.Caption - 1
If Right(Debut, 1) = "]" Then .CompP_2.Caption = .CompP_2.Caption - 1
If Right(Debut, 1) = "(" Then .CompP_3.Caption = .CompP_3.Caption - 1
If Right(Debut, 1) = ")" Then .CompP_4.Caption = .CompP_4.Caption - 1
' recomposition de la formule
If Len(.Fenetre.Value) > 0 Then .Fenetre.Value = Left(Debut, Len(Debut) - 1) & Fin
' reposition le .SelStart
If Len(Debut) - 1 < Len(Debut) + Len(Fin) - 1 Then
.Fenetre.SelStart = Len(Debut) - 1
.Fenetre.SetFocus
End If
' efface la formule
Case 232
.Fenetre.Value = ""
' rappel la mémoire 1
Case 233
If .LibMemoire1.Caption = "M" Then Call Procedure02(CStr(ResM(1)))
' rappel la mémoire 2
Case 234
If .LibMemoire2.Caption = "M" Then Call Procedure02(CStr(ResM(2)))
' rappel la mémoire 3
Case 235
If .LibMemoire3.Caption = "M" Then Call Procedure02(CStr(ResM(3)))
' stock la mémoire 1
Case 236
If Resul <> 0 Then Call Procedure01(1, Resul)
' stock la mémoire 2
Case 237
If Resul <> 0 Then Call Procedure01(2, Resul)
' stock la mémoire 3
Case 238
If Resul <> 0 Then Call Procedure01(3, Resul)
' efface toutes les mémoires
Case 239
Erase ForM ' pour libérer de la mémoire
Erase ResM ' pour libérer de la mémoire
For CompCal = 1 To 3 ' Efface les "LibMemoire"
.Controls("LibMemoire" & CompCal).Caption = ""
Next CompCal
' Execute le calcul "="
Case 240
Call RenvoieLeRésultat
' Transfert le résultat dans le TextBox appelant
Case 241
.Tch_141.Visible = True ' réaffiche l'image normale
If IsNumeric(.Resultat.Caption) = False Then GoTo Suite241: ' si on est en erreur on échappe
.Controls("TxtAp_p1_" & TagMesTxt).Value = Format(.Resultat.Caption, "0.000")
.FrCalculette.Visible = False ' quitte la calculette
Erase TchCal ' pour libérer de la mémoire
Suite241:
.Resultat.Caption = "" ' réinitialse le Resultat
.PourFocus.SetFocus ' renvoi le focus
' renvoi le curseur au début de la formule
Case 242
.Fenetre.SelStart = 0
.Fenetre.SetFocus
' Deplace le curseur vers la droite
Case 243
If .Fenetre.SelStart = 0 Then
.Fenetre.SelStart = Len(.Fenetre.Value) + 1
.Fenetre.SetFocus
GoTo EndSelect:
End If
.Fenetre.SelStart = .Fenetre.SelStart - 1 ' Positionne le curseur
.Fenetre.SetFocus
' Deplace le curseur vers la gauche
Case 244
.Fenetre.SelStart = Len(.Fenetre.Value) + 1 ' Positionne le curseur
.Fenetre.SetFocus
' renvoi le curseur à la fin de la formule
Case 245
If .Fenetre.SelStart = Len(.Fenetre.Value) + 1 Then
.Fenetre.SetFocus
GoTo EndSelect:
End If
.Fenetre.SelStart = .Fenetre.SelStart + 1
.Fenetre.SetFocus
End Select
EndSelect:
' Réinitialistion de la calculette--------------
.Controls("Tch_2" & TagTch).Visible = True
.Controls("Tch_3" & TagTch).Visible = False
If IsNumeric(.Resultat.Caption) Then .Resultat.TextAlign = fmTextAlignRight
If .Fenetre.Value = "" Then
For CompCal = 1 To 4
.Controls("CompP_" & CompCal).Caption = 0
.Controls("CompP_" & CompCal).Visible = False
Next CompCal
End If
'-------------------------------------------------
End If
Case "CrCal" ' Gestion des Croix
If LeTag = 2 Then
.FrCalculette.Visible = False ' fermeture de la calculette
.Label1.Caption = "Double Click sur un des TextBox"
.CrCal_1.Visible = True ' réinitialisation des images de la croix
.CrCal_2.Visible = False
.PourFocus.SetFocus ' renvoi le focus
End If
End Select
LesParentheses (3) ' test sur les parenthèses
End With
End Sub
Sub Procedure01(Index As Byte, LeResul As Double) ' Procedure pour les entrées mémoire
With UserForm1
ForM(Index) = .Fenetre.Value ' Pour l'affiche dans LibRappelMemoire lors du survole des LibMemoire
ResM(Index) = LeResul
.Controls("LibMemoire" & Index).Caption = "M"
End With
End Sub
Sub Procedure02(Fonction As String) ' Procedure pour la composition de la formule
With UserForm1
Debut = Mid(.Fenetre.Value, 1, .Fenetre.SelStart)
Fin = Mid(.Fenetre.Value, .Fenetre.SelStart + 1, Len(.Fenetre.Value))
.Fenetre.Value = Debut & Fonction & Fin
.Fenetre.SelStart = Len(Debut & Fonction) ' repositionne le curseur après la nouvelle entrée
.Fenetre.SetFocus
End With
End Sub
Private Function LesParentheses(Index As Byte) As Boolean
' Fonction pour gérer les fermetures des "[", "(" et inhibition des touches quand fermeture > ouverture
With UserForm1
For CompCal = 1 To 4
If .Controls("CompP_" & CompCal).Caption = 0 Then
.Controls("CompP_" & CompCal).Visible = False
Else
.Controls("CompP_" & CompCal).Visible = True
End If
Next CompCal
Select Case Index
Case 1
If CByte(.CompP_4.Caption) > CByte(.CompP_3.Caption) Then ' test pour les parenthèses
LesParentheses = True
.CompP_4.Caption = .CompP_4.Caption - 1 ' on retanche 1 au compteur
End If
Case 2
If CByte(.CompP_2.Caption) > CByte(.CompP_1.Caption) Then ' test pour les crochets
LesParentheses = True
.CompP_2.Caption = .CompP_2.Caption - 1 ' on retanche 1 au compteur
End If
End Select
End With
End Function |
Pour remettre l’image normale à la sortie de la touche (MouseMove sur la frame)
Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
| Private Sub FrCalculette_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim CompA As Integer
' Remet les touches en "normale"
For CompA = 0 To 45
Me.Controls("Tch_1" & CompA).Visible = True
Me.Controls("Tch_2" & CompA).Visible = False
Next CompA
Me.CrCal_1.Visible = True
Me.CrCal_2.Visible = False
Me.InfoCal_1.Visible = True
Me.InfoCal_2.Visible = False
Me.LibInfo.Visible = False
Me.LibRappelMemoire.Visible = False
End Sub |
Les critiques seront les bienvenues
Bonne journée à tous
27/09/2011, 11h33
J-Pierre Catherine
Une calculette scientifique dans un Usf.
Pensez à Voter pour les réponses qui vous ont aidés, d'avance merci 
..quand c'est le cas !---------
70
et lisez les règles sinon 
