Je transmets à toutes fins utiles une fonction calculant
remboursements de frais professionnels de déplacements.
Notez que dans cette fonction, bien que les valeurs soit typées double, il faut
explicitement les retyper à toutes les étapes de leurs manipulations, afin de ne
pas subir de mauvaises surprises dans les calculs.
Code : Tout sélectionner
REM ***** BASIC *****
'=============================================
'Auteur : martinbrait
'Prix de base général, dit "Frais kilométrique"
'Cas d'utilisation : Calculer le remboursement administratif
'En sortie de la fonction, nous avons une somme en euros.
'suite au déplacement d'un fonctionnaire
'Indemnité restituée à un fonctionnaire suite à un déplacement professionnel
'en paramètre de la fonction, il faut entrer :
'1) les kilomètres effectués par le fonctionnaire
'2) si nécessaire la précision de la 1ère classe (par défaut, le programme considère la deuxième classe, prévue par la loi)
' ----------------- VERSION LIBRE OFFICE -----------------
'))))))))))))))))))))))))))))))))))))))))))))))))
Sub Voyage1()
'Je voyage en deuxième classe, sur 162 kilomètres
InfoUser = MsgBox("Mon remboursement est de " & FraisKilometrique(162, 2) & " euros !")
End Sub
Sub Voyage2()
'voyage de 151.5 kilomètres en première classe
InfoUser = MsgBox("Mon remboursement est de " & FraisKilometrique(151.5, 1) & " euros !")
End Sub
Public Function FraisKilometrique(KilEffect As Double, Optional Classe As Integer) As Double
Dim d As Double
Dim p As Double
Dim A1 As String, A2 As String, b1 As String, B2 As String
'Le prix de base seconde classe, pour les trzajets dans certains trains autres que TGV,
'est calculé selon la formule : P = a + bd
'P étant le prix, remboursé par l'administration
'a étant une constante
'b étant le prix kilométrique
'd étant la distance tarifaire
d = KilEffect
A1 = "1,1672;0,3755;3,1059;4,3337;6,1296;12,1307;11,6366;20,4771;27,6674;48,3062" 'ConstACl1
A2 = "0,7781;0,2503;2,0706;2,8891;4,0864;8,0871;7,7577;13,6514;18,4449;32,2041" 'ConstACl2
b1 = "0,2916;0,3248;0,2396;0,2234;0,2138;0,179;0,1814;0,1545;0,1382;0,1133" 'PrixK1
B2 = "0,1944;0,2165;0,1597;0,1489;0,1425;0,1193;0,1209;0,103;0,0921;0,0755" 'PrixK2
If IsMissing(Classe) Then
Classe = 2
End If
If Classe <> 1 And Classe <> 2 Then
WarningUser = MsgBox("Il y a un problème dans le deuxième paramètre, choisir 1 ou 2", vbExclamation, "ATTENTION AUX PARAMETRES !")
FraisKilometrique = 0
Exit Function
End If
'scenario de remboursement au kilomètre max parcouru :
'distance tarifaire
Select Case d
Case 1 To 16
If Classe = 1 Then
a = Split(A1, ";")(0)
b = Split(b1, ";")(0)
ElseIf Classe = 2 Then
a = Split(A2, ";")(0)
b = Split(B2, ";")(0)
End If
Case 17 To 32
If Classe = 1 Then
a = Split(A1, ";")(1)
b = Split(b1, ";")(1)
ElseIf Classe = 2 Then
a = Split(A2, ";")(1)
b = Split(B2, ";")(1)
End If
Case 33 To 64
If Classe = 1 Then
a = Split(A1, ";")(2)
b = Split(b1, ";")(2)
ElseIf Classe = 2 Then
a = Split(A2, ";")(2)
b = Split(B2, ";")(2)
End If
Case 65 To 109
If Classe = 1 Then
a = Split(A1, ";")(3)
b = Split(b1, ";")(3)
ElseIf Classe = 2 Then
a = Split(A2, ";")(3)
b = Split(B2, ";")(3)
End If
Case 110 To 149
If Classe = 1 Then
a = Split(A1, ";")(4)
b = Split(b1, ";")(4)
ElseIf Classe = 2 Then
a = Split(A2, ";")(4)
b = Split(B2, ";")(4)
End If
Case 150 To 199
If Classe = 1 Then
a = Split(A1, ";")(5)
b = Split(b1, ";")(5)
ElseIf Classe = 2 Then
a = Split(A2, ";")(5)
b = Split(B2, ";")(5)
End If
Case 200 To 300
If Classe = 1 Then
a = Split(A1, ";")(6)
b = Split(b1, ";")(6)
ElseIf Classe = 2 Then
a = Split(A2, ";")(6)
b = Split(B2, ";")(6)
End If
Case 301 To 499
If Classe = 1 Then
a = Split(A1, ";")(7)
b = Split(b1, ";")(7)
ElseIf Classe = 2 Then
a = Split(A2, ";")(7)
b = Split(B2, ";")(7)
End If
Case 500 To 799
If Classe = 1 Then
a = Split(A1, ";")(8)
b = Split(b1, ";")(8)
ElseIf Classe = 2 Then
a = Split(A2, ";")(8)
b = Split(B2, ";")(8)
End If
Case 800 To 9999
If Classe = 1 Then
a = Split(A1, ";")(9)
b = Split(b1, ";")(9)
ElseIf Classe = 2 Then
a = Split(A2, ";")(9)
b = Split(B2, ";")(9)
End If
End Select
p = CDbl(a) + (CDbl(b)*CDbl(d))
FraisKilometrique = Round(CDbl(p), 3)
'en sortie, j'arrondi, à trois chiffres après la virgule,
'afin de recalculer sans erreur d'approximation par la suite
End Function
