Attention : Vous allez constater que pour appeler une macro stockée dans PERSO.XLS depuis un autre classeur, il est nécessaire de faire précéder l'appel par Perso.XLS!. Il faut le savoir...
Il n'existe pas à ma connaissance de fonction Excel qui permet de calculer le montant dû pour une période donnée. Par exemple, si je travaille à 180.--/H et que je travaille pendant 6:00, le résultat va être bien étrange : Essayez vous même : Dans la cellule A1, écrivez 6:00 , dans la cellule A2, écrivez 180, et dans la cellule A3, écrivez =A1*A2. Vous n'aurez pas du tout 1'080.00 comme on pourrait s'y attendre. Bien entendu, on pourrait écrire 6 à la place de 6:00, et ça marcherait, mais alors, comment écrire 6:45 ? Si on écrit 6.45, le calcul sera faux. Il faudrait écrite 6.75 * 180 pour que ce soit juste. La galère !
En fiut c'est la galère parce qu'Excel convertit les heures et les minutes en centièmes de journée. 6:00 est représenté par Excel comme étant 6/24èmes de la journée, c'est à dire le quart, soit 0.25. Donc 6:00 = 0.25.
La fonction que je vous propose de copier dans votre PERSO.XLS afin de l'avoir toujours sous la main est la suivante :
Function CalculMontantSelonBaremeHoraire(Heure,
TarifHoraire) As Single
CalculMontantSelonBaremeHoraire = Heure * 60 * 24 * (TarifHoraire
/ 60)
End Function
Cette fonction peut directement s'appeler dans une feuille de calcul, tout simplement comme ceci (d'ailleurs, si vous l'avez bien recopiée dans Perso.XLS, vous verrez apparaître CalculMontantSelonBaremeHoraire dans la liste des fonctions disponibles)
|
A
|
1
|
8:00 |
2
|
120 |
3
|
=Perso.xls!CalculMontantSelonBaremeHoraire(A1;A2) |
Si vous écrivez la même chose que le tableau ci dessus dans votre feuille Excel, A3 contiendra 960.
Ceci dit, il est également possible, et c'est aussi là toute la force des fonctions personnalisées, d'appeler cette fonction depuis une autre Macro Excel, comme ceci :
Sub NimporteQuoi()
X = CalculMontantSelonBaremeHoraire(#2:00:00 AM#, 150)
MsgBox X ' Affichera 300
' Mais on peut également appeler cette
fonction comme ceci :
MsgBox CalculMontantSelonBaremeHoraire(#2:00:00 AM#, 150)
' Qui affichera 300 également
' Le premier paramètre Heure doit être de type Date/Heure
' MsgBox CalculMontantSelonBaremeHoraire("2:00", 150)
' Ne fonctionne pas
' Mais par contre, si on convertit la chaîne de caractère
en Date/Heure, tout va à nouveau bien :
MsgBox CalculMontantSelonBaremeHoraire(CDate("2:00"),
150)
' (Pour plus d'infos sur CDate, cliquez sur
CDate, et appuyez sur F1)
End Sub
Si on connait le prix d'achat (Par exemple 90 francs), et le prix de vente (Par exemple 110 francs). On peut calculer aisém,ent la marge (110-90 = 20 francs). Mais quel est le pourcentage de marge que l'on fait ? Pour le savoir, il faut faire la formule mathématique suivante : (Prix de vente / Prix d'achat) -1. Dans notre exemple : (110/90 = 1.22222, et 1.2222-1 = 0.2222 qui, en format pourcentage donne 22.2222 % de marge. Dans ce cas précis, on pourrait se demander sérieusement si la construction d'une fonction personnalisée est bien utile. En effet, il suffit de faire la formule suivante :
|
A
|
B
|
C
|
1
|
Prix d'achat | Prix de vente | Marge |
2
|
90 | 110 | =(A2/B2)-1 |
Dans C2, vous obtiendrez dans ce cas 0.22222. Il vous suffit de sélectionner C2 et de le mettre en format % (en cliquant sur le signe %). Maintenant, pour l'exercice, je vous propose de créer une fonction qui va remplacer cette formule, comme ceci :
|
A
|
B
|
C
|
1
|
Prix d'achat | Prix de vente | Marge |
2
|
90 | 110 | =Perso.xls!CalculMarge(A2;B2) |
ATTENTION : Cette fois, il y a 2 paramètres : La fonction devra commencer par CalculMarge(PrixAchat, PrixVente) (Constatez que c'est une virgule et pas un point-virgule qui sépare les paramètres)
Voici la solution, comme pout l'exercice précédent, en blanc sur fond blanc :
Function CalculMarge(PrixAchat,
PrixVente)
CalculMarge = (PrixAchat / PrixVente) - 1
End Function
Un nombre premier est un nombre qui ne se divise par aucun autre nombre, a part bien sûr que par 1 et par lui même. Par exemple, 23 est un nombre premier car il n'est divisible que par 1 et par 23. Bon, il y a des trucs simples, comme par exemple, il n'y a aucun nombre pair premier... Ben oui, puisqu'il est pair, il est forcément divisible par 2. Mais 4397, il est premier ou pas ?
Ce serait vraiment sympathique d'avoir une fonction qui s'appellerait EstPremier et qui renverrait VRAI si le nombre est premier, sinon Faux, comme ceci :
|
A
|
B
|
1
|
23 | =Perso.xls!EstPremier(A1) |
2
|
14 | =Perso.xls!EstPremier(A2) |
3
|
31 | =Perso.xls!EstPremier(A3) |
Qui donnerait réellement sur vore feuille de calcul
|
A
|
B
|
1
|
23 | VRAI |
2
|
14 | FAUX |
3
|
31 | VRAI |
Et bien, cette fonction n'est pas aussi facile à écrire que la précédente. En effet, et heureusement pour les programmeurs, cette fonction requiert une certaine dextérité et de savoir manier les boucles For To Next de manière optimisée. Aussi, je vous renverrai vers le chapitre Apprenez la programmation avec Word, ou à un ouvrage de base sur l'algorithmie pour plus de compréhension.
Toujours est-il que si vous copiez cette fonction dans votre environnement VBA Excel et que vous l'utilisez comme si vous saviez très exactement ce qu'elle fait, vous constaterez qu'elle renvoie effectivement VRAI quand le nombre passé en paramètre est premier, sinon, FAUX. Voici cette fonction :
Function EstPremier(QuelNombre) As
Boolean
If QuelNombre = 1 Then
EstPremier = True
Exit Function
End If
If QuelNombre Mod 2 = 0 Then
EstPremier = False
Exit Function
End If
For Ctr = 3 To QuelNombre / 2 Step 2
If QuelNombre Mod Ctr = 0 Then
EstPremier = False
Exit Function
End If
Next
EstPremier = True
End Function
On pourrait imaginer que cette fonction est un peu une "Boîte noire" dont on ne sait pas grand chose, mais qui nous donne le résultat qu'on attend. Et après tout, c'est tout ce qu'on lui demande !
Partant de ce principe, si on ne voulait pas qu'il écrive VRAI ou FAUX, mais plutôt le mot Premier si le nombre est premier, sinon rien, comme ceci :
|
A
|
B
|
1
|
23 | Premier |
2
|
14 | |
3
|
31 | Premier |
Et bien, nul besoin de changer quoi que ce soit dans la fonction... Ajoutons simplement une fonction SI autour de la fonction EstPremier, comme ceci :
|
A
|
B
|
1
|
23 | =Si(Perso.xls!EstPremier(A1)=VRAI;"Premier";"") |
2
|
14 | =Si(Perso.xls!EstPremier(A2)=VRAI;"Premier";"") |
3
|
31 | =Si(Perso.xls!EstPremier(A3)=VRAI;"Premier";"") |
Bon évidemment ça implique de savoir utiliser la fonction SI...
Dans le chapitre des macros complémentaires, vous avez eu le loisir d'étudier l'ajout de la fonction préexistante ARRONDI.AU.MULTIPLE. Si vous êtes curieurx de voir comment cette fonction est écrite, voici la même fonction (je ne sais pas si elle est vraiment identique à ARRONDI.AU.MULTIPLE, mais en tout cas elle retourne les mêmes résultats)
Function ArrondiPersonnalise(QuelNombre,
QuellePrecision)
ArrondiPersonnalise = CLng(QuelNombre * (1 / QuellePrecision)) /
(1 / QuellePrecision)
End Function
|
A
|
B
|
C
|
D
|
1 |
Nombre |
Fonction | Arrondi à | Résultat |
2
|
1472 | =PERSO.XLS!ArrondiPersonnalise(A1;20) | 20 francs | 1480 |
3
|
2.67 | =PERSO.XLS!ArrondiPersonnalise(A2;0.05) | 5 centimes | 2.65 |
4
|
3.31 | =PERSO.XLS!ArrondiPersonnalise(A3;0.25) | 25 centimes | 3.25 |
Vous allez vous livrer à un petit exercice de création de fonction personnalisée. Il s'agit de créer une fonction qui transforme les degrés centigrades en degrés Farenheit. La formule mathématique est : C° = (5/9) X (F°-32). Par exemple, 100° Farenheit = (5/9) X (100-32)° Centigrades. 5 divisé par 9 = 0.55555. 100-32 = 68. 0.5555 X 68 = 37.774 (degrés Farenheit)
Il faudrait que l'on puisse appeler la formule comme ceci :
|
A
|
B
|
C
|
1 |
C° |
Fonction | Vous avez résussi si vous obtenez : |
2
|
23 | =PERSO.XLS!Farenheit(A1) | 42.77777778 |
3
|
-5 | =PERSO.XLS!Farenheit(A2) | 58.33333333 |
4
|
180 | =PERSO.XLS!Farenheit(A3) | -44.44444444 |
La solution se trouve juste ici en dessous, mais elle est écrite en blanc sur fond blanc, ce qui fait que si vous voulez la voir, vous devez sélectionner les 3 lignes ici en dessous, faire Edition/Copier, et les coller dans votre VBA Excel, par exemple juste en dessous de la fonction que vous avez créé vous même, pour voir si vous avez bien compris :
Function Farenheit(DegreCentigrade)
Farenheit = (5 / 9) * (100 - DegreCentigrade)
End Function
L'idée est ici de faciliter particulièrement la tâche aux concepteurs de bases de données qui désirent cumuler des heures et des minutes (de travail par exemple), et d'obtenir un total d'heures de travail supérieur à 24 en gardant le format de Date/Heure standard Cette fonction permet de calculer la somme de 2 ou plusieurs dates dont le total est éventuellement supérieur à 24 heures sans afficher un format du style "02:30" au lieu de "26:30" Cette fonction prend en charge 2 paramètres : Interval, qui n'est autre que la somme de 2 ou plusieurs heures. Par exemple, imaginons un formulaire qui contient 2 champs Temps1 et Temps2. Interval pourrait très bien être : Temps1 + Temps2. Le 2ème paramètre est Fmt (Format), qui est une chaîne de caractère devant faire partie de la liste énumérée ici-bas ("J H" , "H:MM", etc.)
EXEMPLE :
Admettons que le Champs Temps1 contienne 23:59, et le champs Temps2 contienne 01:00
MsgBox FormatInterval (Temps1 + Temps2 , "H:MM")
Affichera 24:59 (et non pas 00:59)
J'ai constaté que certaines des constantes de Fmt ne fonctionnaient pas complètement bien. Par contre les deux formats
H:MM
(24:59 par exemple) et
H:MM:SS (24:59:00 par exemple)
eux, fonctionnent parfaitement, et ça tombe bien, ce sont les 2 formats les plus intéressants.
' Cette
fonction permet de renvoyer des formats de dates en heures, minutes et secondes
supérieures à 24 heures
' Formats supportés (Dans le paramètre Fmt)
' J H 5 jours 5 heures
' J H:MM 5 jours 5:15
' J HH:MM 5 jours 05:15
' J H:MM:SS 5 jours 5:15:45
' J HH:MM:SS 5 jours 05:15:45
' H M 125 heures 15 Minutes
' H:MM 125:15
' H:MM:SS 125:15:45
' M S 7515 Minutes 45 Secondes
Function FormatInterval(ByVal Interval As Variant, Fmt As String)
Dim Days As Long, Hours As Long, Minutes As Long, Seconds
As Long
' S'agit-il d'une date ou d'un
nombre à virgule ?
If VarType(Interval) <> 7 And VarType(Interval)
<> 5 Then Exit Function
Days = Int(Interval)
Interval = Interval - Days
If Interval > #11:59:59 PM# Then
Days = Days + 1
Interval = 0#
End If
Interval = Interval * 24
Hours = Int(Interval)
Interval = Interval - Hours
If Interval > 3599# / 3600# Then
Hours = Hours + 1
Interval = 0#
End If
Interval = Interval * 60
Minutes = Int(Interval)
Interval = Interval - Minutes
If Interval > 59# / 60# Then
Minutes = Minutes + 1
Interval = 0#
End If
Seconds = Int(Interval * 60 + 0.5)
If Seconds = 60 Then
Minutes = Minutes + 1
Seconds = 0
End If
If Minutes > 59 Then
Hours = Hours + 1
Minutes = Minutes - 60
End If
If Hours > 23 Then
Days = Days + 1
Hours = Hours - 24
End If
Select Case Fmt
Case "J H"
FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Hours
& IIf(Hours <> 1, " Heures", " Heure")
Case "J H:MM"
FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Hours
& ":" & Format(Minutes, "00")
Case "J HH:MM"
FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Hours
& Format(Hours, "00") & ":" & Format(Minutes, "00")
Case "J H:MM:SS"
FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Hours
& ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")
Case "J HH:MM:SS"
FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Format(Hours,
"00") & ":" & Format(Minutes, "00") & ":" & Format(Seconds,
0)
Case "H M"
Hours = Hours + Days * 24
FormatInterval = Days & IIf(Days <> 1, "Jours ", " Jour ") & Hours
& Minutes & IIf(Minutes <> 1, "Minutes", " Minute")
' Le cas le plus intéressant, et qui marche :
Case "H:MM"
Hours = Hours + Days * 24
FormatInterval = Hours & ":" & Format(Minutes, "00")
'
Le 2ème cas le plus intéressant qui marche :
Case "H:MM:SS"
Hours = Hours + Days * 24
FormatInterval = Hours & ":" & Format(Minutes, "00") & ":" &
Format(Seconds, "00")
Case "M S"
Minutes = Minutes + (Hours + Days * 24) * 60
FormatInterval = Minutes & IIf(Minutes <> 1, " Minutes ", " Minute ")
& Seconds & IIf(Seconds <> 1, " Secondes", " Seconde")
Case Else
FormatInterval = "Format invalide"
End Select
End Function
Cette fonction permet d'extraire une partie d'une chaîne de caractères quand celle ci a toujours la même structure. Prenons l'exemple suivant : Vous avez un fichier texte qui contient les lignes suivantes :
Marc Dupont, Ville : Paris, E-Mail : mdupont@truc.fr,
Tél.: 43.99.88.09
Yvan Desclous, Ville : Grenoble, E-Mail : desclous@machin.fr, Tél.: 11.22.33.44
Paul Truc, Ville : Berlin, E-Mail : tpaul@chose.fr, Tél.: 44.66.55.88
Pour Extraire l'E-Mail de chacune de ces personnes, je vous souhaite bonne chance, surtout s'il y en a 2'500... La petite fonction que je vous propose d'implémenter va s'occuper de tout cela...
Dans notre exemple, nous voulons mettre l'E-Mail dans une variable VARemail :
LigneComplete = "Marc Dupont, Ville
: Paris, E-Mail : mdupont@truc.fr, Tél.: 43.99.88.09"
VARemail =Extraction(LigneComplete , "E_Mail : "
, ", Tél")
VARemail contiendra exactement la chaîne suivante : mdupont@truc.fr
On
ne peut pas utiliser cette grande fonction directement dans Excel. Pour une
raison que j'ignore, il faut appeler une autre petite fonction qui appelle la
grande, comme ceci :
Function
PrendreUnePartie(ChaineTexte, Depuis, Jusqua)
PrendreUnePartie = Extraction(ChaineTexte, Depuis, Jusqua)
End Function
Dans Excel, =Extraction("abcdef";"a";"c")
donne une erreur, mais =PrendreUnePartie("abcdef";"a";"c")
est correct...
' UTILITE : Cette fonction
permet de récupérer une chaîne de texte dans une chaîne de caractères, entre
' 2 balises.
' EXEMPLES :
' X = Extraction ("ABCDEFGHIJKL", "CD", "i") Renvoie
"EFGH"
' X = Extraction ("ABCDEFGHIJKL", "#BEGIN#", "i")
Renvoie "ABCDEFGH"
' X = Extraction ("ABCDEFGHIJKL", "#BEGIN#", "#END#")
Renvoie "ABCDEFGHIJKL"
' X = Extraction ("ABCDEFGHIJKL", "J", "#END#")
Renvoie "KL"
' X = Extraction ("ABCDEFGHIJKL", "J", "J") Renvoie
"###INFO 3000 ERREUR : Fin avant de début, ou retour fonction vide ###"
' X = Extraction ("ABCDEFGHIJKL", "J", "K") Renvoie
"###INFO 3000 ERREUR : Fin avant de début, ou retour fonction vide ###"
' X = Extraction ("BxxxA AyyyB", "a", "b") Renvoie
"###INFO 3000 ERREUR : Fin avant de début, ou retour fonction vide ###"
' X = Extraction ("ABCDEFGHIJKL", "XXX", "J")
Renvoie "###INFO 3000 ERREUR : Début inexistant###"
' X = Extraction ("ABCDEFGHIJKL", "XXX", "YYY")
Renvoie "###INFO 3000 ERREUR : Début inexistant###"
' X = Extraction ("ABCDEFGHIJKL", "BC", "XXX")
Renvoie "###INFO 3000 ERREUR : Fin inexistante ###"
' X = Extraction ("AbonjourZ AaurevoirZ", "a", "z")
Renvoie "bonjour"
Function Extraction(ChaineTexte, Depuis, Jusqua)
Dim Ctr As Integer ' Compteur polyvalent
Dim Drapeau As Boolean ' Détermine si une erreur est survenue (les
balises DEPUIS ou JUSQUA n'existent pas)
Dim PositionDebut As Integer ' Contient la position de la fin de
la chaine DEBUT + 1 caractere
Dim PositionFin As Integer ' Contient la position du début de la
chaine JUSQUA
Dim LongueurDepuis As Integer ' Contient la longueur de la balise
DEPUIS
Dim LongueurJusqua As Integer ' Contient la longueur de la balise
JUSQUA
Dim LongueurChaineTexte As Integer ' Contient la longueur de la
chaîne de caractère complète
LongueurDepuis = Len(Depuis)
LongueurJusqua = Len(Jusqua)
LongueurChaineTexte = Len(ChaineTexte)
' Est-ce que l'utilisateur a entré un mot-clé pour commencer au
début : #BEGIN#
' ou terminer à la fin : #END#
If Depuis = "#BEGIN#" Then
PositionDebut = 1
End If
If Jusqua = "#END#" Then
PositionFin = LongueurChaineTexte
End If
If Depuis <> "#BEGIN#" Then
' Recherche de la délimitation DEBUT du début
de la recherche
Drapeau = False
For Ctr = 1 To LongueurChaineTexte - LongueurDepuis
If Mid$(ChaineTexte,
Ctr, LongueurDepuis) = Depuis Then
Drapeau
= True
PositionDebut
= Ctr + LongueurDepuis
Exit
For
End If
Next
' Si la délimitation du début DEPUIS n'existe
pas, générer une erreur
If Drapeau = False Then
Extraction = "###INFO
3000 ERREUR : Début inexistant###"
Exit Function
End If
End If
If Jusqua <> "#END#" Then
' Recherche de la délimitation FIN
Drapeau = False
For Ctr = 1 To LongueurChaineTexte - LongueurJusqua
If Mid$(ChaineTexte,
Ctr, LongueurJusqua) = Jusqua Then
Drapeau
= True
PositionFin
= Ctr - 1
Exit
For
End If
Next
' Si la délimitation de fin JUSQUA n'existe pas,
générer une erreur
If Drapeau = False Then
Extraction = "###INFO
3000 ERREUR : Fin inexistante ###"
Exit Function
End If
End If
If PositionFin < PositionDebut Then
Extraction = "###INFO 3000 ERREUR : Fin
avant de début, ou retour fonction vide ###"
Exit Function
End If
' Retour correct de la fonction :
Extraction = (Mid$(ChaineTexte, PositionDebut, PositionFin - (PositionDebut
- 1)))
End Function