KASHEMA Aïda Prof: C.
MAULE 2023-2024
Cours de VBA Excel
19/09/2023
INTRODUCTION
Comment accéder à VBA :
Excel → Option → Personnaliser le ruban → Cocher « Développeur » → Cliquer sur l’onglet
« Développeur » → Cliquer sur « Visual Basic » → Clique droit Feuille → Module →
Insertion→ Taper « Option Explicit » en 1ère ligne de code
Sauvegarder (changement d’enregistrement) :
- Sélectionner « Classeur Excel (prenant en charge les macros) » → .xlsm
Le Sub est une procédure qui n’a pas de valeur retour.
Il est aussi utilisé pour définir des sous-procédures effectuant des tâches spécifiques
dans VBA (elles sont ensuite appelées pour exécuter des actions définies) (from
ChatGpt).
Début : Sub test()
Fin : End Sub
Faire un commentaire → commencer par une apostrophe
Mettre en gras → ActiveCell.Font.Bold = True permet d’affecter le style gras à la
cellule sélectionnée
Cells(n°ligne, n°colonne).Value
Range(« coordonnée de la cellule »).Value
Entrer des données dans une cellule
Exemple technique cells :
Sub test()
'envoyer dans la cellule C4 des données: 1234
Cells(4, 3).Value = 1234
End Sub
Exemple technique range :
Sub test()
'envoyer dans la cellule C4 des données: 1234
Range("C5").Value = 1234
End Sub
Faire une operation arithmétique:
Sub test()
'envoyer dans la cellule C4 des données: 1234
Cells(4, 3).Value = 1234
Range("C5").Value = 1234
'recuperer le contenu de A4 et le diviser par 2
Cells(4, 1).Value = Cells(4, 1).Value / 2
End Sub
Faire un calcul arithmétique
Sub test()
'envoyer dans la cellule C4 des données: 1234
Cells(4, 3).Value = 1234
Range("C5").Value = 1234
'recuperer le contenu de A4 et le diviser par 2
Range(“A4”).Value = Range(“A4”).Value / 2
End Sub
Faire un calcul arithmétique
Sub test()
'envoyer dans la cellule C4 des données: 1234
Cells(4, 3).Value = 1234
Range("C5").Value = 1234
'recuperer le contenu de A4 et le diviser par 2
Cells(4, 1).Value = Cells(4, 1).Value / 2
'calculer le carré de A4 et le mettre dans B4
Cells(4, 1).Value = 5
Cells(4, 2).Value = Cells(4, 1).Value * Cells(4, 1).Value
End Sub
Avec range:
Range(“B4”).value = range(“A4”).Value * range(“A4”).Value
Pour avoir la racine carrée
Range(“B4”).value = sqr((Range(“A4”).Value))
Ecrire du texte “Bonjour” + Copier le contenu d’une cellule dans une autre
cellule(C6→ D6)
Sub test()
'envoyer dans la cellule C4 des données: 1234
Cells(4, 3).Value = 1234
Range("C5").Value = 1234
Range("C6").Value = "Bonjour"
Range("D6").Value = Range("C6").Value
'recuperer le contenu de A4 et le diviser par 2
Cells(4, 1).Value = Cells(4, 1).Value / 2
'calculer le carré de A4 et le mettre dans B4
Cells(4, 1).Value = 5
Cells(4, 2).Value = Cells(4, 1).Value * Cells(4, 1).Value
End Sub
Créer des macros
Enregister une macro
Sélectionner la cellule + Modification (exemple : Changer la couleur)
Accéder
Retourner dans Visual et sélectionner le Module 2
Déplacer le contenu d’une cellule dans une cellule d’une autre feuille
➔ Utiliser Le point d’exclamation pour indiquer que c’est une feuille
Sub testmultifeuille()
'recopier A1 de la feuille client vers A1 de la feuille produit
Range("produits!A1").Value = Range("clients!A1").Value
End Sub
Autre technique
Sub testmultifeuille()
'recopier A1 de la feuille client vers A1 de la feuille produit
Range("produits!A1").Value = Range("clients!A1").Value
'idem avec cells
Worksheets("produits").Cells(2, 1).Value = Worksheets("clients").Cells(2, 1).Value
End Sub
Tt ce qui sera executer dans une feuille → Activate
Sub testmultifeuille()
'recopier A1 de la feuille client vers A1 de la feuille produit
Range("produits!A1").Value = Range("clients!A1").Value
'idem avec cells
Worksheets("produits").Cells(2, 1).Value = Worksheets("clients").Cells(2, 1).Value
'activation d'une feuille de calcul
Worksheets("produits").Activate
'dans la feuille de calcul produit
Range("A10").Value = 200
Range("B10").Value = 200
Worksheets("clients").Activate
'dans la feuille client
Range("A10").Value = 200
Range("B10").Value = 200
End Sub
➔ Faire un Worksheets (« nom de la feuille »). Activate pour savoir où va être
exécuter le code
Déclarer une variable
On utilise « dim » → Dimensionner une variable/ Réserver de l’espace en mémoire
pour stocker une variable
Sub testactivate()
Dim variable_compteur As Integer
Dim variable_chaine As String
End Sub
Rappel:
1 octet → 8bits (en anglais = byte)
1 tera → 1000 milliards d’octets
1 caractère =1 octet = 8 bits
Stocker une variable en mémoire pour la réutiliser :
Sub testactivate()
Dim variable_vrai_faux As Boolean
Dim variable_compteur As Integer
Dim variable_chaine As String
variable_compteur = 50
Range("A5").Value = variable_compteur
End Sub
Il faut rafraichir le contenu de la variable :
Sub testactivate()
Dim variable_vrai_faux As Boolean
Dim variable_compteur As Integer
Dim variable_chaine As String
variable_compteur = 50
Range("A5").Value = variable_compteur
variable_compteur = variable_compteur + 1
'rafraichissement de A5 avec la nouvelle valeur
Range("A5").Value = variable_compteur
End Sub
Décrire un programme permettant de prendre 2 cellules et d’ intervertir les 2
valeurs contenues dans ces cellules (Swaper)
Utiliser une seule variable de type Integer
Maximum 4 lignes de code (sans les Sub)
A la base : C2 = 45 /// D2 = 60
Sub swaper()
Dim sumo As Integer
sumo = Range("C2").Value
Range("C2").Value = Range("D2").Value
Range("D2").Value = sumo
End Sub
26/09/2023
INTERRO -Correction
Consigne : Swaper les variables x et y (pas de range et cells)
X=5
Y = 10
Z=x
x=y
y=z
Correction dans VBA
Sub swap()
Dim x, y, z As Integer
x=5
y = 10
z=x
x=y
y=z
Debug.Print x
Debug.Print y
Debug.Print z
End Sub
Fenêtre d’exécution (onglet Affichage):
10
5
5
Effacer le contenu d’une cellule :
Sub effacer()
Range("A1).Select
Selection.Clear
End Sub
Effacer le contenu de plusieurs cellules
Sub effacer()
Range("A1:D1).Select
Selection.Clear
End Sub
Avec les Cellules B1 et B2 (même exo)
Sub swapB1B2()
Dim sumo As Integer
sumo = Range("B1").Value
Range("B1").Value = Range("B2").Value
Range("B2").Value = sumo
End Sub
Avec un “String”
Sub swapC1C2()
Dim x As String
X = Range("C1").Value
Range("C1").Value = Range("C2").Value
Range("C2").Value = x
End Sub
Sauvegarder uniquement le code
Clique droit Module → Exporter→ NomDuFichier.bas
Les CONDITIONS
Ecrire un message
Sub IF_THEN()
If 3 > 2 Then
MsgBox "3 est plus grand que 2"
End If
End Sub
Ecrire un message avec Else
Sub IF_THEN()
If 3 > 2 Then
MsgBox "3 est plus grand que 2"
Else
MsgBox "condition du if non validée"
End If
End Sub
Sub compareA1A2()
If Range("A1").Value > Range("A2").Value Then
MsgBox "A1 est plus grand que A2"
Else
MsgBox "A2 est plus grand que A1"
End If
End Sub
Avec Elseif
Sub compareA1A2()
If Range("A1").Value > Range("A2").Value Then
MsgBox "A1 est plus grand que A2"
ElseIf (Range("A2").Value > Range("A1").Value) Then
MsgBox "A2 est plus grand que A1"
Else
MsgBox "A1 = A2"
End If
End Sub
➔ If fermé par un « End If »
Les BOUCLES
Il existe 6 sortes de boucles en VBA mais on utilisera que 3 types
de boucle :
While / For / Do While
EXERCICE : compter le nombre de a dans les 5ères cellules de la
colonne F (sans boucles juste if)
Sub compter_les_a_dans_F()
Dim compteur As Integer
Dim lettre As String
compteur = 0
lettre = "a"
If Range("F1").Value = lettre Then
compteur = compteur + 1
End If
If Range("F2").Value = lettre Then
compteur = compteur + 1
End If
If Range("F3").Value = lettre Then
compteur = compteur + 1
End If
If Range("F4").Value = lettre Then
compteur = compteur + 1
End If
If Range("F5").Value = lettre Then
compteur = compteur + 1
End If
MsgBox "il y a " & compteur & " lettres a"
End Sub
DEVOIR pour le 03/10 - EXERCICE :On a 3 nombres : 10 , 11 et 12 →
afficher le plus grand des 3 nombres
03/10/2023
Devoir (ma réponse) :
Sub le_plus_grand()
Dim nb1 As Integer
Dim nb2 As Integer
Dim nb3 As Integer
nb1 = 10
nb2 = 11
nb3 = 12
If (nb1 > nb2) And (nb1 > nb3) Then
MsgBox "nb1 est le plus grand"
ElseIf (nb2 > nb1) And (nb2 > nb3) Then
MsgBox "nb2 est le plus grand"
Else
MsgBox "nb3 est le plus grand"
End If
End Sub
Avec les cellules
Sub le_plus_grand_dans_la_cellule()
If Range("A1").Value > Range("B1").Value And Range("A1").Value >
Range("C1").Value Then
MsgBox (Range("A1").Value & " est le plus grand")
ElseIf Range("B1").Value > Range("A1").Value And Range("B1").Value >
Range("C1").Value Then
MsgBox (Range("B1").Value & " est le plus grand")
Else
MsgBox (Range("C1").Value & " est le plus grand")
End If
End Sub
Mettre dans l’ordre décroissant
Sub du_plus_grand_au_plus_petit()
Dim nb1, nb2, nb3 As Integer
nb1 = 10
nb2 = 10
nb3 = 0
If (nb1 > nb2) And (nb1 > nb3) Then
If nb2 > nb3 Then
MsgBox nb1 & nb2 & nb3
Else
MsgBox nb1 & nb3 & nb2
End If
ElseIf (nb2 > nb1) And (nb2 > nb3) Then
If nb1 > nb3 Then
MsgBox nb2 & nb1 & nb3
Else
MsgBox nb2 & nb3 & nb1
End If
Else
If nb2 > nb1 Then
MsgBox nb3 & nb2 & nb1
Else
MsgBox nb3 & nb1 & nb2
End If
End If
End Sub
10/10/2023
Test VBA
Ecrire un programme qui affiche le produit négatif, positif ou nul SANS
PASSER PAR UN CALCUL DE PRODUIT
Sub produit_neg_pos()
Dim x As Integer
Dim y As Integer
x = -4
y=5
If (x < 0) And (y < 0) Then
MsgBox ("Produit positif")
ElseIf (x < 0) Or (y < 0) Then
MsgBox ("Produit négatif")
ElseIf (x = 0) Or (y = 0) Then
MsgBox ("Produit nul")
Else
MsgBox ("Produit positif")
End If
End Sub
Avec valeurs déjà dans les cellules
Sub produit_neg_pos()
Dim x As Integer
Dim y As Integer
x = Range("A1").Value
y = Range("B1").Value
If (x < 0) And (y < 0) Then
MsgBox ("Produit positif")
ElseIf (x < 0) Or (y < 0) Then
MsgBox ("Produit négatif")
ElseIf (x = 0) Or (y = 0) Then
MsgBox ("Produit nul")
Else
MsgBox ("Produit positif")
End If
End Sub
Afficher des nombres de 1 à 10
Sub compteur()
Dim compteur As Integer
For compteur = 1 To 10
'affichage du compteur
Debug.Print compteur
Next compteur
End Sub
Remplir une colonne avec des chiffres de 1 à 10
Sub compteur_colonne()
Dim compteur As Integer
For compteur = 1 To 10
'affichage du compteur
Debug.Print compteur
Cells(compteur, 1).Value = compteur
Next compteur
End Sub
Remplir une ligne avec des chiffres de 1 à 10
Sub compteur_colonne()
Dim compteur As Integer
For compteur = 1 To 10
'affichage du compteur
Debug.Print compteur
Cells(1, compteur).Value = compteur
Next compteur
End Sub
Afficher la table de 5 sur 10 lignes dans la 2e colonne
Sub table_cinq()
Dim compteur As Integer
For compteur = 1 To 10
'affichage du compteur
Debug.Print compteur
Cells(compteur, 2).Value = compteur * 5
Next compteur
End Sub
Remplir une ligne en DIAGONALE avec des chiffres de 1 à 10
Sub de_1à10_en_diagonale_vers_la_droite()
Dim compteur As Integer
For compteur = 1 To 10
'affichage du compteur
Debug.Print compteur
Cells(compteur, compteur).Value = compteur
Next compteur
End Sub
17/10/2023
Ecrire → Debug.int
Lire → InputBox
Tracer un carré de 10 sur 10
Sub tracer_carre()
Dim largeur, compteur As Integer
largeur = 9
For compteur = 1 To largeur
'bordure supérieure
Cells(1, compteur).Interior.Color = vbBlack
'bordure inférieure
Cells(9, compteur).Interior.Color = vbBlack
'bordure gauche
Cells(compteur, 1).Interior.Color = vbBlack
'bordure droite
Cells(compteur, 9).Interior.Color = vbBlack
'diagonale de gauche à droite
Cells(compteur, compteur).Interior.Color = vbBlack
'diagonale de droite à gauche
Cells(compteur, 10 - compteur).Interior.Color = vbBlack
Next compteur
End Sub
Faire un triangle à partir du coin inférieur droit du carré précédent
Sub ligne()
Dim largeur, compteur_ligne, compteur_colonne As Integer
largeur = 5
For compteur_ligne = 1 To largeur
For compteur_colonne = 1 To largeur
Cells(compteur_ligne, compteur_colonne) = compteur_colonne
Next compteur_colonne
Next compteur_ligne
End Sub
Ecrire de 1 jusqu’à 25
Sub ligne()
Dim largeur, compteur_ligne, compteur_colonne, chiffre As Integer
largeur = 5
chiffre = 1
For compteur_ligne = 1 To largeur
For compteur_colonne = 1 To largeur
Cells(compteur_ligne, compteur_colonne) = chiffre
chiffre = chiffre + 1
Next compteur_colonne
Next compteur_ligne
End Sub
DEVOIR : Faire un triangle à partir du coin inférieur droit du carré précédent
24/10/2023
Téléchargement de Freefdp sur Softonic :
https://freedfd.fr.softonic.com/telecharger
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+++++++
Puis extraire tout et ouvrir la version anglaise
Afficher 1 à 10
Table de n’importe quel chiffre
Sub multi()
Dim nombre, compteur, chiffre As Integer
nombre = InputBox("Quelle table? ")
For compteur = 1 To 10 Step 1
chiffre = compteur * nombre
Debug.Print chiffre
Next compteur
End Sub
Faire une boucle imbriquée
Sub boucle_imbriq()
Dim ligne, colonne As Integer
For ligne = 1 To 4 Step 1
For colonne = 1 To 4
Debug.Print "ligne = " & ligne & "colonne = " & colonne
Next colonne
Next ligne
End Sub
'ligne = ' , ligne, 'colonne = ' , colonne
Afficher de 1 à 25
Afficher exposant 2
Sub expo_De_deux()
Dim ligne, colonne, chiffre As Integer
chiffre = 1
For ligne = 1 To 3 Step 1
For colonne = 1 To 3
Cells(ligne, colonne).Value = chiffre
chiffre = chiffre * 2
Next colonne
Next ligne
End Sub
Le damier
Sub damier()
Dim ligne, colonne, chiffre As Integer
chiffre = 1
For ligne = 1 To 9
For colonne = 1 To 9
Cells(ligne, colonne).Value = chiffre
chiffre = chiffre + 1
If chiffre Mod 2 = 0 Then
Cells(ligne, colonne).Interior.Color = vbBlack
Else
Cells(ligne, colonne).Interior.Color = vbYellow
End If
Next colonne
Next ligne
End Sub
DEVOIR : Faire une pyramide avec 2 boucles imbriquées
07/11/2023
Faire un carré
Sub carre25()
Dim hauteur, colonne, ligne As Integer
hauteur = 10
For ligne = 1 To hauteur
For colonne = 1 To hauteur
Debug.Print ligne, " ", colonne
Next colonne
Next ligne
End Sub
14/11/2023
Damier avec le if et des 1 et 2
Sub exo_damier()
Dim n, cased, ligne, colonne, x As Integer
n=5
cased = 1
For ligne = 1 To n
If ligne Mod 2 = 1 Then
cased = 2
Else
cased = 1
End If
For colonne = 1 To n
Cells(ligne, colonne).Value = cased
cased = 3 - cased
Next colonne
Next ligne
End Sub
Damier sans le if
Sub exo_SansIF1()
Dim h, premierecase, cased, ligne, colonne, x As Integer
h=6
cased = 1
premierecase = 1
For ligne = 1 To h
'initialiser cased
cased = premierecase
For colonne = 1 To h
Cells(ligne, colonne).Value = cased
cased = 3 - cased 'changement de valeur
Next colonne
'calcul de la premiere case pour la ligne suivante
premierecase = 3 - premierecase
Next ligne
End Sub
Pour faire l’escalier
Sub pyramide()
Dim h, cased, ligne, colonne, premierecasedeligne As Integer
h=6
For ligne = 1 To h
For colonne = 1 To ligne
'colorier en noir
Cells(ligne, colonne).Interior.Color = vbBlack
Next colonne
Next ligne
End Sub
Pour faire l’escalier dans l’autre sens
Sub pyramide()
Dim h, cased, ligne, colonne, premierecasedeligne As Integer
h=6
For ligne = 1 To h
For colonne = ligne To h ‘1-6; 2-6 ; 3-6
'colorier en noir
Cells(ligne, colonne).Interior.Color = vbBlack
Next colonne
Next ligne
End Sub
Autre pyramide
Sub pyramide()
Dim h, cased, ligne, colonne, premierecasedeligne As Integer
h=6
For ligne = ligne To h
For colonne = h + 1 - ligne To h ‘6-6 ; 5-6 ; 4-6 ; 3-6
'colorier en noir
Cells(ligne, colonne).Interior.Color = vbBlack
Next colonne
Next ligne
End Sub
CODE FINAL PYRAMIDE
Sub pyramide()
Dim h, cased, ligne, colonne, premierecasedeligne As Integer
h=6
For ligne = ligne To h
For colonne = h + 1 - ligne To h - 1 + ligne
'colorier en noir
Cells(ligne, colonne).Interior.Color = vbBlack
Next colonne
Next ligne
End Sub
BOUCLE « While »
➔ Si on ne remplit pas la condition, on ne rentre pas dans la boucle
Les SYMBOLES et OPÉRATEURS
Compter les x (pré-écris dans le tableau excel)
Sub compterlesX()
Dim i, compteur as Integer
compteur = 0
For i = 1 To 99999
If (Cells(i, 1).Value = "x") Then
compteur = compteur + 1
End If
Next i
Debug.Print compteur
End Sub
Continuer à boucler tant que la cellule est remplie
Sub bouclewhile()
Dim compteur, ligne As Integer
compteur = 0
ligne = 1
‘boucler tant que je ne suis pas arrivée sur une cellule vide
While (Cells(ligne, 1).Value <> "")
‘si je rencontre un X j’incrémente le compteur
If (Cells(i, 1).Value = "x") Then
‘incrémenter le compteur
compteur = compteur + 1
End If
‘passer à la ligne suivante
ligne = ligne + 1
Wend ‘fin du while
Debug.Print compteur
End Sub
Ecrire de 1 à 10 dans la colonne B
Sub while10()
'remplir la 2de colonne avec 1 à 10
Dim compteur As Integer
compteur = 1
While (compteur <= 10)
Cells(compteur, 2).Value = compteur
compteur = compteur + 1
Wend
End Sub
21/11/2023
DEVOIR
Sub deviner ()
Dim x as Integer
x = 50
‘ecrire une boucle qui sans s’arrêter demande 1 chiffre à l’utilisateur jusqu’à ce qu’on
tape le bon chiffre x
Sub deviner()
Dim x, y As Integer
x = 50
While y <> x
y = InputBox("Entrez un chiffre: ")
If y = x Then
MsgBox " VOUS AVEZ TROUVÉ!"
Else
MsgBox "Pas le bon! Essayez encore: "
End If
Wend
End Sub
28/11/2023 (vacances)
05/12/2023
Rappel boucle For + While
Sub boucle_for()
Dim i As Integer
For i = 1 To 10
Cells(i, 1).Value = i * 5
Next i
End Sub
Sub boucle_while()
'table de 5 dans la 2e colonne
'10 lignes
Dim compteur As Integer
compteur = 1 ‘initialisation à 1 IMPORTANT AVANT UTILISATION DU compteur
While (compteur <= 10)
Cells(compteur, 2).Value = compteur * 5
compteur = compteur + 1
Wend
End Sub
BOUCLE « Do While »
➔ Faire ce qu’il y a dans la boucle au moins 1 fois puis on teste la condition puis
on voit si on peut reboucler
➔ Do… Loop While
Table de 5 dans la 3e colonne
Sub boucle_do_while()
Dim i As Integer
i=1
Do
Cells(i, 3).Value = i * 5
i=i+1
Loop While (i<=10)
End Sub
Vérifier si ce que l’utilisateur a entré est un chiffre puis lui redemander si ce
qu’il a entré n’est pas un chiffre (jusqu’à ce que ce soit un chiffre)
+Choisir le bon type de boucle
➔ On choisit la boucle DO WHILE
Sub verif_de_saisie()
Dim pin_code As Integer
Dim saisie As String
pin_code = 1234
'vérif du pin code
'le pin code doit etre numerique
'vérifier si la saisie est correcte
'si pas correct: redemander à l'utilisateur nou
'obliger de demander au moins 1 fois à l'utilisateur
'demande à l'utilisateur de taper le pin code
Do
saisie = InputBox("Tapez le pin code: ")
'redemander tant que la saisie n'est pas de type numérique
Loop While (Not IsNumeric(saisie) Or Len(saisie) <> 4)
'ici on est sur que la saisie est numérique
'comparer avec le pin code
If (Val(saisie) = pin_code) Then 'Val signifie convertir en valeur numérique
MsgBox ("le pin code est CORRECT!")
Else
MsgBox ("le pin code est INCORRECT!")
End Sub
Verifier si l’utilisateur a bien entré une adresse e-mail
InStr et Mid
Les fonctions InStr et Mid sont souvent utilisées pour manipuler des chaînes de
caractères.
InStr (In String):
La fonction InStr est utilisée pour trouver la position d'une sous-chaîne dans une
chaîne principale.
Syntaxe : InStr([start], string1, string2, [compare])
- start (optionnel) : spécifie la position de départ de la recherche.
-string1 : la chaîne dans laquelle vous recherchez.
-string2 : la sous-chaîne que vous recherchez.
-compare (optionnel) : spécifie le type de comparaison. La plupart du temps, vous
pouvez le laisser vide.
EXEMPLE :
vbaCopy code
Dim position As Integer position = InStr(1, "Hello World", "World")
MsgBox position ' Affichera 7, car "World" commence à la position 7 dans "Hello
World".
Mid (Mid String):
La fonction Mid est utilisée pour extraire une partie d'une chaîne.
Syntaxe : Mid(string, start, [length])
-string : la chaîne d'origine.
-start : la position de départ de l'extraction.
-length (optionnel) : la longueur de la sous-chaîne à extraire. Si omis, il extrait jusqu'à
la fin.
EXEMPLE 1 :
Dim sousChaine As String
sousChaine = Mid("Hello World", 7)
MsgBox sousChaine ' Affichera "World", car l'extraction commence à la position 7.
EXEMPLE 2 :
Dim sousChaine As String
sousChaine = Mid("Hello World", 7, 3)
MsgBox sousChaine ' Affichera "Wor", car l'extraction commence à la position 7 et a
une longueur de 3.
(from ChatGPT)
Sub validation_email()
Dim saisie As String
'verifier si saisie est un adresse email
'verifier si on retrouve l'@'
saisie = InputBox("Tapez votre adresse email: ")
If (InStr(saisie, "@") > 0) Then
'cest une adresse email
MsgBox "adresse email OK"
Else
MsgBox "adresse email PAS OK"
End If
End Sub
Les FONCTIONS
On ne commence plus par un « Sub ». À la place on écrit « Function » et on
termine le code par « End Function ».
Créer une fonction qui vérifie les emails (verifier_email)
Function verifier_email(saisie As String) As Boolean
'fonction renvoyant un booleen
'cette fonction renvoie VRAI si saisie est un email
If (InStr(saisie, "@") > 0) Then
'return True
verifier_email = True
Else
'return False
verifier_email = False
End If
End Function
Exemple 1 d’appel de fonction (verifier_email)
Sub validation_email_do_while()
'tant que l'utilisateur ne tape pas un email valide
'on lui redemande son email
Dim saisie As String
'boucler tant que l'email n'est pas correct
Do
saisie = InputBox("Tapez votre email :")
Loop While (verifier_email(saisie) = False)
'appel de fonction
End Sub
Exemple 2 d’appel de fonction (verifier_email)
Sub validation_email_do_while_2()
'AVEC RESULT : récuperer la sortie de la fonction
'tant que l'utilisateur ne tape pas un email valide
'on lui redemande son email
Dim saisie As String
Dim result As Boolean
'boucler tant que l'email n'est pas correct
Do
saisie = InputBox("Tapez votre email :")
result = verifier_email(saisie)
Loop While (result = False)
'appel de fonction
End Sub
EXERCICE (pdf du cours slide 79)
Code ASCII
Alt 64 = @
Alt 65 = A , Alt 66 = B, etc. // Alt 97 = a , Alt 98 = b, etc.
Remplir une colonne avec les nombres de 1 à 100
Sub boucle_1à100()
Dim i As Integer
For i = 1 To 100
Cells(i, 9).Value = i
Next i
End Sub
Remplir une colonne avec les lettres de A à Z →majuscule
Sub exercice_seq_lettres_MAJ()
'MsgBox(Chr(65))
Dim i As Integer
For i = 1 To 26
Cells(i, 1).Value = Chr(64 + i)
'minuscule : Chr(96 +i)
Next i
End Sub
Remplir une colonne avec les lettres de A à Z →minuscule dans la 5e colonne
Sub exercice_seq_lettres_MIN()
'MsgBox(Chr(65))
Dim i As Integer
For i = 1 To 26
Cells(i, 5).Value = Chr(96+ i)
Next i
End Sub
Remplir une colonne avec les puissances de 2 (2,4,8,16.. 2^x)
Sub puissanceDe2()
Dim i As Integer
Dim compteur As Integer
compteur = 1 'initialisation à 1 IMPORTANT AVANT UTILISATION DU compteur
While (compteur <= 10)
Cells(compteur, 8).Value = 2 ^ compteur
compteur = compteur + 1
Wend
End Sub
12/12/2023
Les TABLEAUX
Créer d’un tableau (0 à 9)
Sub creation_tableau()
Dim monTableau(9) As Integer
Dim i As Integer
'remplir le tableau de 1à10
For i = 0 To 9
monTableau(i) = i + 1
Next i
'visualisation/recopier dans une feuille Excel
For i = 0 To 9
Cells(i + 1, 1) = monTableau(i)
Next i
End Sub
Créer un tableau (1 à10)
Sub creationTab2()
Dim monTableau(1 To 10) As Integer
Dim i As Integer
'remplir le tableau de 1à10
For i = 1 To 10
monTableau(i) = i
Next i
'visualisation/recopier dans une feuille Excel
For i = 1 To 10
Cells(i, 2) = monTableau(i)
Next i
End Sub
Les fonctions :
LBound et UBound
LBound (Lower Bound) et UBound (Upper Bound) sont utilisées pour obtenir les
indices de limite inférieure et supérieure d'un tableau ou d'une collection. Ces
fonctions sont souvent utilisées dans le cadre de la manipulation des tableaux.
LBound :
La fonction LBound retourne l'indice de la limite inférieure d'un tableau dans une
dimension donnée.
Syntaxe : LBound(Array, [Dimension])
Array : Le tableau pour lequel vous souhaitez obtenir la limite inférieure.
Dimension : Facultatif. La dimension pour laquelle vous souhaitez obtenir la limite
inférieure. Par défaut, la première dimension est utilisée.
Exemple :
Dim myArray(1 To 10) As Integer
Dim lowerBound As Integer
lowerBound = LBound(myArray)
MsgBox "Lower Bound: " & lowerBound ' Affiche 1
UBound :
La fonction UBound retourne l'indice de la limite supérieure d'un tableau dans une
dimension donnée.
Syntaxe : UBound(Array, [Dimension])
Array : Le tableau pour lequel vous souhaitez obtenir la limite supérieure.
Dimension : Facultatif. La dimension pour laquelle vous souhaitez obtenir la limite
supérieure. Par défaut, la première dimension est utilisée.
Exemple :
Dim myArray(1 To 10) As Integer
Dim upperBound As Integer
upperBound = UBound(myArray)
MsgBox "Upper Bound: " & upperBound ' Affiche 10
Créer un tableau (avec les Bound)
Sub creationTab3()
Dim monTableau(1 To 10) As Integer
Dim i As Integer
'remplir le tableau de 1à10
For i = LBound(montTableau) To UBound(monTableau)
monTableau(i) = i
Next i
'visualisation/recopier dans une feuille Excel
For i = 1 To 10
Cells(i, 3) = monTableau(i)
Next i
End Sub
Faire un tableau 2D (5 sur 5)
Sub tableau2D()
Dim monTableau2D(1 To 5, 1 To 5) As Integer
Dim i, j As Integer
'remplir le tableau 2D
For i = 1 To 5
For j = 1 To 5
monTableau2D(i, j) = i + j
Next j
Next i
'visualiser le tableau dans une feuille de calcul
For i = 1 To 5
For j = 1 To 5
Cells(i, j).Value = monTableau2D(i, j)
Next j
Next i
End Sub
Rechercher le mininum ou maximum dans un tableau + Créer des fonctions
Function maximum(tableau As Variant) As Integer
'renvoie le maximum du tableau
Dim max, i As Integer
max = tableau(LBound(tableau))
For i = LBound(tableau) To UBound(tableau)
If tableau(i) > max Then
max = tableau(i)
End If
Next i
'return
maximum = max
End Function
Appel de la fonction maximum (exercice précédent) → renvoie logiquement 66
Sub test_maximum()
'test de la fonction maximum
Dim monTableau(1 To 10) As Integer
monTableau(1) = 10
monTableau(2) = 27
monTableau(3) = 28
monTableau(4) = 62
monTableau(5) = 40
monTableau(6) = 66
monTableau(7) = 50
monTableau(8) = 2
monTableau(9) = 55
monTableau(10) = 42
MsgBox maximum(monTableau) ‘appel de la fonction
End Sub
Modifier les valeurs d’un tableau + utilisation de ReDim
ReDim
ReDim est utilisée pour redimensionner un tableau (array) existant. On peut l'utiliser pour
modifier la taille d'un tableau existant en spécifiant le nouveau nombre d'éléments dans une
ou plusieurs dimensions.
« Redim » est une instruction/ commande et pas une fonction car elle ne renvoie aucune
valeur.
→ Syntaxe de base :
ReDim NomDuTableau(NouvelleTaille)
Exemple :
Sub ExempleRedim()
Dim monTableau() As Integer
ReDim monTableau(1 To 5) ' Crée un tableau avec 5 éléments
' Utilisation du tableau initial
For i = LBound(monTableau) To UBound(monTableau)
monTableau(i) = i * 10
Next i
' Affichage du tableau initial
MsgBox Join(monTableau, ", ") ' Affiche "10, 20, 30, 40, 50"
' Redimensionnement du tableau
ReDim monTableau(1 To 8) ' Redimensionne le tableau avec 8 éléments
' Utilisation du tableau redimensionné
For i = LBound(monTableau) To UBound(monTableau)
monTableau(i) = i * 10
Next i
' Affichage du tableau redimensionné
MsgBox Join(monTableau, ", ") ' Affiche "10, 20, 30, 40, 50, 60, 70, 80"
End Sub
(from ChatGpt)
Function multiplier_tableau(tableau As Variant, multiplicateur As Integer) As Variant
'multiplication des valeurs d'un tableau
'renvoie un tableau
Dim tableau_resultat As Variant
Dim i As Integer
ReDim tableau_resultat(LBound(tableau) To UBound(tableau))
For i = LBound(tableau) To UBound(tableau)
tableau_resultat(i) = tableau(i) * multiplicateur
Next i
'return
multiplier_tableau = tableau_resultat
End Function
Appel de la fonction multiplier_tableau (exercice précédent)
Sub tester_multiplier_tableau()
Dim i As Integer
Dim resultat As Variant
Dim monTableau(1 To 10) As Integer
monTableau(1) = 10
monTableau(2) = 27
monTableau(3) = 28
monTableau(4) = 62
monTableau(5) = 40
monTableau(6) = 66
monTableau(7) = 50
monTableau(8) = 2
monTableau(9) = 55
monTableau(10) = 42
resultat = multiplier_tableau(monTableau, 2) 'appel de la fct
'visualisation du resultat
For i = LBound(resultat) To UBound(resultat)
Cells(i, 10).Value = resultat(i)
Next i
End Sub
Fonction multiplier_modifier_tableau
Function multiplier_modifier_tableau(tableau As Variant, multiplicateur As Integer) As
Variant
'multiplication des valeurs d'un tableau
'renvoie un tableau
Dim tableau_resultat As Variant
Dim i As Integer
ReDim tableau_resultat(LBound(tableau) To UBound(tableau))
For i = LBound(tableau) To UBound(tableau)
tableau(i) = tableau(i) * multiplicateur
Next i
'return
multiplier_modifier_tableau = tableau_resultat
End Function
Appel de la fonction multiplier_modifier-tableau()
Sub tester_multiplier_modifier_tableau()
Dim i As Integer
Dim resultat As Variant
Dim monTableau(1 To 10) As Integer
monTableau(1) = 10
monTableau(2) = 27
monTableau(3) = 28
monTableau(4) = 62
monTableau(5) = 40
monTableau(6) = 66
monTableau(7) = 50
monTableau(8) = 2
monTableau(9) = 55
monTableau(10) = 42
resultat = multiplier_modifier_tableau(monTableau, 2) 'appel de la fct
'visualisation du resultat
For i = LBound(resultat) To UBound(resultat)
Cells(i, 11).Value = monTableau(i)
Next i
End Sub
Passage d’argument par référence
(dans le cours :CoursCM1Bureautique slide 73)
« ByVal » et « ByRef » sont utilisés pour spécifier le passage de paramètres dans
les procédures (sub-procédures ou fonctions). Ils déterminent comment les
arguments sont transmis à la procédure.
ByVal (By Value):
Lorsque vous utilisez ByVal, la valeur réelle de l'argument est passée à la procédure.
Cela signifie que toute modification apportée à la valeur du paramètre à l'intérieur de
la procédure n'affectera pas la variable d'origine à partir de laquelle la procédure a
été appelée.
Dans l’exemple qui suit :
→Le x est modifié à l'intérieur de ExampleByVal
→la variable num à l'extérieur de la procédure reste inchangée.
Sub ExampleByVal(ByVal x As Integer)
x=x+1
MsgBox "Inside Sub: " & x
End Sub
Sub TestByVal()
Dim num As Integer
num = 5
ExampleByVal num
MsgBox "Outside Sub: " & num
End Sub
REPONSE :
Inside Sub: 6
Outside Sub: 5
ByRef (By Reference):
Lorsque vous utilisez ByRef, un lien vers la variable d'origine est passé à la
procédure.
Cela signifie que toute modification apportée à la valeur du paramètre à l'intérieur de
la procédure affectera également la variable d'origine.
Sub ExampleByRef(ByRef y As Integer)
y=y+1
MsgBox "Inside Sub: " & y
End Sub
Sub TestByRef()
Dim num As Integer
num = 5
ExampleByRef num
MsgBox "Outside Sub: " & num
End Sub
REPONSE :
Inside Sub: 6
Outside Sub: 6
(from ChatGpt)
Différent type de fonction (ByVal, Call, ByRef)
Sub Calcul()
Dim Montant As Integer
Montant = 10
Call Produit1(Montant, 2) 'appel une procedure
MsgBox "Montant = " & Montant
End Sub
Sub Produit1(ByVal Nb As Integer, n As Integer) ‘la fonction
Nb = Nb * n
End Sub
Sub Produit2(ByRef Nb As Integer, n As Integer)
Nb = Nb * n
End Sub
On prend une variable puis on la multiplie
Function Produit1_fun(ByVal Nb As Integer, n As Integer) As Integer
Nb = Nb * n
Produit1_fun = Nb
End Function
Function Produit2_fun(ByRef Nb As Integer, n As Integer) As Integer
Nb = Nb * n
Produit2_fun = Nb
End Function
Sub Calcul2()
Dim Montant As Integer
Montant = 10
MsgBox Produit1_fun(Montant, 2) & " Montant= " & Montant
MsgBox Produit2_fun(Montant, 2) & " Montant= " & Montant
End Sub
Faire des tris
Méthode : LE TRI À BULLES
Le tri à bulles (Bubble Sort en anglais) est un algorithme simple de tri qui fonctionne
en comparant et en échangeant les éléments adjacents s'ils sont dans le mauvais
ordre (from ChatGpt).
Sub tri_bulle(ByRef tableau As Variant)
Dim indice_depart As Integer
Dim indice_max As Integer
Dim i As Integer
indice_depart = LBound(tableau)
indice_max = UBound(tableau)
'boucle des passes
For i = indice_depart To indice_max - 1
'comparaison et swap
If tableau(i) > tableau(i + 1) Then
Call swap(tableau(i), tableau(i + 1))
Next i
End Sub
--------------------------------------------------------------------------------------------------
Sub swap(ByRef tableau As Variant, i As Integer, ByRef j As Integer)
Dim tampon As Integer
tampon = tableau(i)
tableau(i) = tableau(i + 1)
tableau(i + 1) = tampon
End If
End Sub
-------------------------------------------------------------------------------------------
Sub test_tri_bulle()
Dim monTableau(1 To 10) As Integer
Dim i As Integer
monTableau(1) = 10
monTableau(2) = 27
monTableau(3) = 28
monTableau(4) = 62
monTableau(5) = 40
monTableau(6) = 66
monTableau(7) = 50
monTableau(8) = 2
monTableau(9) = 55
monTableau(10) = 42
For i = LBound(monTableau) To UBound(monTableau)
Cells(i, 1).Value = monTableau(i)
Next i
End Sub
Faire des tris (partie 2)
Sub tri_bulle(ByRef tableau As Variant)
Dim indice_depart As Integer
Dim indice_max As Integer
Dim i, passe As Integer
indice_depart = LBound(tableau)
indice_max = UBound(tableau)
'boucle des passes
For passe = 1 To (indice_max - indice_depart - 1)
For i = indice_depart To indice_max - passe
'comparaison et swap
If tableau(i) > tableau(i + 1) Then
Call swap(tableau, i, i + 1)
End If
Next i
Next passe
End Sub
Sub swap(ByRef tableau As Variant, ByVal i As Integer, ByVal j As Integer)
Dim tampon As Integer
tampon = tableau(i)
tableau(i) = tableau(j)
tableau(j) = tampon
End Sub
Sub test_tri_bulle()
Dim monTableau(1 To 10) As Integer
Dim i As Integer
monTableau(1) = 10
monTableau(2) = 27
monTableau(3) = 28
monTableau(4) = 62
monTableau(5) = 40
monTableau(6) = 66
monTableau(7) = 50
monTableau(8) = 2
monTableau(9) = 55
monTableau(10) = 42
Call tri_bulle(monTableau)
For i = LBound(monTableau) To UBound(monTableau)
Cells(i, 1).Value = monTableau(i)
Next i
End Sub
Exercice SUPP
Fait avec ChatGpt
Afficher en bleu la cellule qui contient la plus petite valeur numérique de la
colonne A
Sub MettreEnSurbrillancePlusPetiteValeur()
Dim colonneA As Range
Dim celluleMin As Range
' Définir la plage dans la colonne A à partir de la deuxième ligne
Set colonneA = ActiveSheet.Range("A1:A" &
ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row)
' Trouver la cellule avec la plus petite valeur
Set celluleMin =
colonneA.Cells(Application.WorksheetFunction.Match(Application.WorksheetFunctio
n.Min(colonneA), colonneA, 0))
' Mettre en surbrillance en bleu
celluleMin.Interior.Color = vbBlue
End Sub
Afficher la table de multiplication (tableau 10X10)
Sub AfficherTableMultiplication()
Dim i As Integer
Dim j As Integer
' Remplir le tableau de multiplication
For i = 1 To 10
For j = 1 To 10
Cells(j, i).Value = i * j
Next j
Next i
End Sub
Rechercher dans la cellule contenant le mot "cible" et afficher ses
coordonnées (ex: A4)
Sub RechercherEtAfficherCoordonnees()
Dim ws As Worksheet
Dim rechercheCellule As Range
' Définir la feuille de calcul
Set ws = ThisWorkbook.Sheets("TableMultiplication") ‘ma feuille s appelle
TableMultiplication
' Rechercher le mot "cible" dans la colonne A
Set rechercheCellule = ws.Columns("A").Find("cible", LookIn:=xlValues)
' Vérifier si le mot a été trouvé
If Not rechercheCellule Is Nothing Then
' Afficher les coordonnées de la cellule
MsgBox "Coordonnées de la cellule contenant 'cible': " &
rechercheCellule.Address
Else
' Si le mot n'a pas été trouvé
MsgBox "Le mot 'cible' n'a pas été trouvé dans la colonne A."
End If
End Sub
Explication du code :
• "Set" est utilisé pour créer une référence d'objet.
• "ws" est le nom de la variable qui va contenir cette référence d'objet (dans ce
cas, une feuille de calcul).
• "ThisWorkbook" est un mot-clé qui fait référence au classeur (workbook)
dans lequel le code est en cours d'exécution.
• "Sheets("NomDeVotreFeuille")" est une méthode qui récupère une référence
à une feuille spécifique du classeur. Vous devez remplacer
"NomDeVotreFeuille" par le nom réel de votre feuille de calcul.
• "rechercheCellule" est le nom de la variable qui va contenir cette référence
d'objet (dans ce cas, une plage de cellules).
• "ws.Columns("A").Find("cible", LookIn:=xlValues)" est une expression qui
recherche le mot "cible" dans la colonne A de la feuille de calcul référencée
par "ws".
• "Columns("A")" sélectionne toute la colonne A de cette feuille.
• ".Find("cible", LookIn:=xlValues)" recherche le mot "cible" dans cette
colonne en utilisant la méthode Find. Les options "LookIn:=xlValues"
spécifient que la recherche doit être effectuée dans les valeurs des
cellules.
Rechercher dans la cellule contenant le nombre 999 et afficher ses
coordonnées (ex: A4)
Sub RechercherNombre999()
Dim ws As Worksheet
Dim rechercheCellule As Range
' Définir la feuille de calcul
Set ws = ThisWorkbook.Sheets("TableMultiplication") ‘ma feuille s appelle
TableMultiplication
' Rechercher le nombre 999 dans la colonne A
Set rechercheCellule = ws.Columns("A").Find(999, LookIn:=xlValues)
' Vérifier si le nombre a été trouvé
If Not rechercheCellule Is Nothing Then
' Afficher les coordonnées de la cellule
MsgBox "Coordonnées de la cellule contenant '999': " &
rechercheCellule.Address
Else
' Si le nombre n'a pas été trouvé
MsgBox "Le nombre '999' n'a pas été trouvé dans la colonne A."
End If
End Sub
