COURS VBA EXCEL

1. Dire si le nombre saisi est supérieur à 10

Sub SupérieurA10()
Dim nb As Double
nb = CDbl(TextBox1.Value)
If nb > 10 Then
MsgBox "Supérieur à 10"
Else
MsgBox "Inférieur ou égal à 10"
End If
End Sub
2. Dire si le nombre est pair ou impair
Sub PairImpair()
Dim nb As Integer
nb = CInt(TextBox1.Value)
If nb Mod 2 = 0 Then
MsgBox "Pair"
Else
MsgBox "Impair"
End If
End Sub
3. Dire si le nombre est premier
Sub Premier()
Dim nb As Integer, i As Integer, estPremier As Boolean
nb = CInt(TextBox1.Value)
estPremier = True
If nb <= 1 Then estPremier = False
For i = 2 To Sqr(nb)
If nb Mod i = 0 Then
 estPremier = False
Exit For
End If
Next i
If estPremier Then
MsgBox "Premier"
Else
MsgBox "Non premier"
End If
End Sub
4. Compter les occurrences de 'a' et 'A'
Sub CompterA()
Dim texte As String, count As Integer, i As Integer
texte = TextBox1.Value
count = 0
For i = 1 To Len(texte)
If Mid(texte, i, 1) = "a" Or Mid(texte, i, 1) = "A" Then
count = count + 1
End If
Next i
MsgBox "Nombre de 'a' et 'A': " & count
End Sub
5. Vérifier si c'est un palindrome
Sub Palindrome()
Dim texte As String, i As Integer, estPalindrome As Boolean
texte = LCase(TextBox1.Value)
estPalindrome = True
For i = 1 To Len(texte) \ 2
If Mid(texte, i, 1) <> Mid(texte, Len(texte) - i + 1, 1) Then
 estPalindrome = False
Exit For
End If
Next i
If estPalindrome Then
MsgBox "Palindrome"
Else
MsgBox "Non palindrome"
End If
End Sub
6. Saisie de tableau dynamique
Sub SaisieTableau()
Dim tableau() As Integer, taille As Integer, saisie As String, continuer As Boolean
taille = 0
continuer = True

Do While continuer
ReDim Preserve tableau(taille)
saisie = InputBox("Entrez un élément (vide pour arrêter):")
If saisie = "" Then
continuer = False
Else
tableau(taille) = CInt(saisie)
taille = taille + 1
End If
Loop

Dim resultat As String, i As Integer

resultat = "Tableau: "
 For i = LBound(tableau) To UBound(tableau)
resultat = resultat & tableau(i) & " "
Next i
MsgBox resultat
End Sub
Partie 2
1. Somme des 3 zones de texte
Private Sub TextBox4_Change()
TextBox4.Value = Val(TextBox1.Value) + Val(TextBox2.Value) + Val(TextBox3.Value)
End Sub
2. Valeur maximale des 3 zones
vba
Copy
Private Sub TextBox4_Change()
Dim maxVal As Double
maxVal = Val(TextBox1.Value)
If Val(TextBox2.Value) > maxVal Then maxVal = Val(TextBox2.Value)
If Val(TextBox3.Value) > maxVal Then maxVal = Val(TextBox3.Value)
TextBox4.Value = maxVal
End Sub
3. Concaténation des 3 zones
Private Sub TextBox4_Change()
TextBox4.Value = TextBox1.Value & TextBox2.Value & TextBox3.Value
End Sub
4. Afficher la case cochée
vba
Copy
Private Sub CheckBox1_Click()
If CheckBox1.Value Then TextBox1.Value = CheckBox1.Caption
End Sub

Private Sub CheckBox2_Click()

If CheckBox2.Value Then TextBox1.Value = CheckBox2.Caption
End Sub

Private Sub CheckBox3_Click()

If CheckBox3.Value Then TextBox1.Value = CheckBox3.Caption
End Sub
5. Copier la couleur des boutons
Private Sub CommandButton1_Click()
CommandButton4.BackColor = CommandButton1.BackColor
End Sub

Private Sub CommandButton2_Click()

CommandButton4.BackColor = CommandButton2.BackColor
End Sub

Private Sub CommandButton3_Click()

CommandButton4.BackColor = CommandButton3.BackColor
End Sub
Partie3
1. Insérer des chaînes dans une liste
Private Sub CommandButton1_Click()
ListBox1.AddItem TextBox1.Value
ListBox1.AddItem TextBox2.Value
ListBox1.AddItem TextBox3.Value
End Sub
2. Trier une liste par ordre croissant
Private Sub CommandButton2_Click()
Dim i As Long, j As Long
Dim temp As String

For i = 0 To ListBox1.ListCount - 2
For j = i + 1 To ListBox1.ListCount - 1
If ListBox1.List(i) > ListBox1.List(j) Then
temp = ListBox1.List(i)
ListBox1.List(i) = ListBox1.List(j)
ListBox1.List(j) = temp
End If
Next j
Next i
End Sub
3. Afficher des cases à cocher toutes les X secondes
Dim NextTick As Double
Private Sub UserForm_Initialize()
NextTick = Timer + 5 ' Change toutes les 5 secondes
CheckBox1.Visible = True
CheckBox2.Visible = False
CheckBox3.Visible = False
End Sub

Private Sub UserForm_Activate()

Application.OnTime Now + TimeValue("00:00:01"), "ToggleCheckboxes"
End Sub

Sub ToggleCheckboxes()
If Timer >= NextTick Then
 CheckBox1.Visible = Not CheckBox1.Visible
CheckBox2.Visible = Not CheckBox2.Visible
CheckBox3.Visible = Not CheckBox3.Visible
NextTick = Timer + 5
End If
Application.OnTime Now + TimeValue("00:00:01"), "ToggleCheckboxes"
End Sub
4. Changer l'image d'un bouton
Dim CurrentImage As Integer

Private Sub UserForm_Initialize()

CurrentImage = 1
CommandButton1.Picture = LoadPicture("chemin_image1.jpg")
End Sub

Private Sub CommandButtonChanger_Click()

CurrentImage = CurrentImage + 1
If CurrentImage > 3 Then CurrentImage = 1

Select Case CurrentImage

Case 1
CommandButton1.Picture = LoadPicture("chemin_image1.jpg")
Case 2
CommandButton1.Picture = LoadPicture("chemin_image2.jpg")
Case 3
CommandButton1.Picture = LoadPicture("chemin_image3.jpg")
End Select
End Sub
Partie3
1. Application lecture/écriture fichier
vba
Copy
' Module principal
Private Sub CommandButtonEcrire_Click()
Dim filePath As String
filePath = Application.GetOpenFilename("Fichiers texte (*.txt), *.txt")
If filePath <> "False" Then
Open filePath For Output As #1
Print #1, TextBox1.Value
Close #1
MsgBox "Contenu enregistré avec succès"
End If
End Sub

Private Sub CommandButtonLire_Click()

Dim filePath As String
Dim ligne As String
filePath = Application.GetOpenFilename("Fichiers texte (*.txt), *.txt")

If filePath <> "False" Then

ListBox1.Clear
Open filePath For Input As #1
Do Until EOF(1)
Line Input #1, ligne
ListBox1.AddItem ligne
Loop
Close #1
 End If
End Sub
2. Application déplacement d'images
' Dans le module UserForm
Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As
Single, ByVal Y As Single)
If Button = 1 Then ' Clic gauche
Image1.Tag = "DRAG"
End If
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X

As Single, ByVal Y As Single)
If Image1.Tag = "DRAG" Then
Image1.Left = X - Image1.Width / 2
Image1.Top = Y - Image1.Height / 2
End If
End Sub

Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As

Single, ByVal Y As Single)
Image1.Tag = ""
End Sub
3. Application variation couleur RVB
' Module principal
Private Sub CommandButtonChangerCouleur_Click()
Dim rouge As Integer, vert As Integer, bleu As Integer

rouge = Int(Rnd() * 256)

vert = Int(Rnd() * 256)
 bleu = Int(Rnd() * 256)

CommandButton1.BackColor = RGB(rouge, vert, bleu)

TextBox1.Value = "R: " & rouge & " V: " & vert & " B: " & bleu
End Sub

' Initialisation dans UserForm_Initialize

Private Sub UserForm_Initialize()
Randomize
End Sub