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
|
Option Compare Database
Option Explicit
Private Const SUCCESS = 32
Private Sub cmdTest_Click()
Dim Param1
Dim Param2
Dim strFinalMessage As String
Dim MsgError As String
Dim SrcError As String
Dim HError As Long
Dim lngRetFunct1 As Long
Dim lngRetFunct2 As Long
Dim lngRetFunct3 As Long
Dim dblResultat As Double
On Error GoTo L_ErrcmdTest_Click
strFinalMessage = "Aucune action n'a été effectuée."
If MsgBox("Effectuer le truc à faire ?", vbQuestion + vbYesNo, "Confirmer") = vbYes Then
Param1 = Me!ChampParam1
Param2 = Me!ChampParam2
If Not IsNull(Param1) And Not IsNull(Param2) Then
lngRetFunct1 = Fonction1(CLng(Param1), CLng(Param2), MsgError, HError, SrcError)
If lngRetFunct1 = False Then
Err.Raise HError, SrcError, MsgError
End If
lngRetFunct2 = Fonction2(CLng(Param1), CLng(Param2), MsgError, HError, SrcError)
If lngRetFunct2 = 0 Then
Err.Raise HError, SrcError, MsgError
Else
lngRetFunct3 = Fonction3(lngRetFunct2, dblResultat, MsgError, HError, SrcError)
If lngRetFunct3 = False Then
Err.Raise HError, SrcError, MsgError
End If
End If
strFinalMessage = "La tâche a été opérée avec succès : Résultat = " & Round(dblResultat, 4)
Else
Err.Raise 94, "cmdTest_Click", "Renseignez d'abord les paramètres !"
End If
End If
On Error GoTo 0
L_ExcmdTest_Click:
MsgBox "Procédure terminée." & vbCrLf & vbCrLf & strFinalMessage, vbInformation, "Fin"
Exit Sub
L_ErrcmdTest_Click:
strFinalMessage = "Il y a eut un problème :" & vbCrLf & Err.Description & vbCrLf & vbCrLf & "Réf. appel : " & Err.Source & vbCrLf & "(Erreur N° " & Err.Number & ")"
Resume L_ExcmdTest_Click
End Sub
Private Function Fonction1(ByVal Param1 As Long, ByVal Param2 As Long, ByRef MsgError As String, ByRef HError As Long, ByRef SrcError As String) As Boolean
On Error GoTo L_ErrFonction1
SrcError = "Fonction1"
If Param1 < Param2 Then
Err.Raise 6, "Fonction1", "Param1 est plus petit que Param2 !"
End If
Fonction1 = True
On Error GoTo 0
L_ExFonction1:
Exit Function
L_ErrFonction1:
HError = Err.Number
MsgError = Err.Description
Resume L_ExFonction1
End Function
Private Function Fonction2(ByVal Param1 As Long, ByVal Param2 As Long, ByRef MsgError As String, ByRef HError As Long, ByRef SrcError As String) As Long
Dim lngRet As Long
On Error GoTo L_ErrFonction2
SrcError = "Fonction2"
lngRet = (Param1 / Param2) * SUCCESS
If lngRet < SUCCESS Then
Err.Raise 11, "Fonction2", "Param2 ne permet pas la division ou n'est pas supérieur à " & SUCCESS
End If
Fonction2 = lngRet
On Error GoTo 0
L_ExFonction2:
Exit Function
L_ErrFonction2:
HError = Err.Number
MsgError = Err.Description
Resume L_ExFonction2
End Function
Private Function Fonction3(ByVal Param1 As Long, ByRef Resultat As Double, ByRef MsgError As String, ByRef HError As Long, ByRef SrcError As String) As Boolean
On Error GoTo L_ErrFonction3
SrcError = "Fonction3"
Randomize
Resultat = (Param1 * Rnd)
If Resultat < 400 Then
Err.Raise 11, "Fonction3", "Param1 est trop petit pour avoir un résultat correct !"
End If
Fonction3 = True
On Error GoTo 0
L_ExFonction3:
Exit Function
L_ErrFonction3:
HError = Err.Number
MsgError = Err.Description
Resume L_ExFonction3
End Function |
Requête de mise à jour avec invite pré-renseignée
Répondre avec citation
.
Envoyé par sibama
Partager