Excel par l'exemple
Macro commandes pour les pros

 

pour travailler avec les macros dans Excel 2007, activez l'onglet "Développeur" dans le ruban.
Bouton Office / options excel / standard / cochez "Affichez l'onglet Développeur dans le ruban"


Accueil
Guides Excel
Excel en Vidéos
Formules de calcul
Exercices
Raccourcis Clavier
Raccourcis Clavier
Trucs et Astuces
Applications
Forum Utilisateurs
Ancien Forum
Liens Utiles
Livre d'Or
Contact

Utilisez le contenu d'une cellule pour nommer votre onglet


Repérez des doublons dans une plage de cellules
Nommez automatiquement un onglet à partir du contenu d'une cellule
Toujours ouvrir un classeur sur une feuille définie
Compter le nombre de fois où une valeur est présente dans une feuille de calcul
Ouvrir Word à partir d'Excel Convertir des nombres en heures
Additionner les nombres contenus dans les cellules dont le texte est en bleu (ou rouge, ou vert, etc.)
Compter le nombre de cellules dont le fond est coloré en bleu (ou rouge, ou vert, etc.)
Une macro de conversion Francs- Euros et Euros-Francs
Convertir des majuscules en minuscules
Convertir un nombre en lettres (fonctionne avec des Francs ou des Euros)
Ajouter le nom complet du classeur dans le pied de page (pour édition) de la feuille
Masque les lignes vides d'une sélection
Sélection d'une plage de cellules à partir d'une cellule sélectionnée


Utilisez le contenu d'une cellule pour nommer votre onglet

Vous voulez nommer un onglet en reprenant le contenu d'une cellule. Par exemple vous avez écrit dans la cellule A1 le mot "janvier" et vous voulez que l'onglet se nomme "janvier".

  • Lancez l'éditeur VBA (menu "Outils/ macros/ Visual Basic Editor") ou par ALT + F11
  • CRTL + R pour accéder à VBA project en haut à gauche
  • Là double cliquez sur THISWORKBOOK
  • Placez (copiez/collez) la macro ci-dessous :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
'Macro par ADM
Application.ScreenUpdating = False
If Application.Intersect(Target, Range("A1")) Is Nothing Then End
ActiveSheet.Name = Target.Value
Application.ScreenUpdating = True
End Sub

Dans la macro changez éventuellement la référence de cellule A1 par la référence de cellule de votre choix.


Repérez des doublons dans une plage de cellules

Vous venez de saisir ou récupérer une liste et vous voulez vérifiez si elle contient des doublons. Créez la macro expliquée ci-dessous et exécutez-la. Les premières valeurs de la liste seront mises sur fond vert et les doublons repérés sur fond rouge.

  • Lancez l'éditeur VBA (menu "Outils/ macros/ Visual Basic Editor") ou par ALT + F11
  • CRTL + R pour accéder à VBA project en haut à gauche
  • Là double cliquez sur THISWORKBOOK
  • Placez (copiez/collez) la macro ci-dessous :

Sub Doublons()
Dim Collec As New Collection, Cell As Range, Plage As Range

On Error Resume Next
Set Plage = Application.InputBox("Plage à examiner", Type:=8)
If IsEmpty(Plage) Then Exit Sub

For Each Cell In Plage
If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear
Cell.Interior.ColorIndex = 3
Else
Cell.Interior.ColorIndex = 4
End If
End If
Next Cell
End Sub


Nommez automatiquement un onglet à partir du contenu d'une cellule

Vous souhaitez que votre onglet comporte automatiquement le texte saisi dans une cellule de votre choix. Par exemple, un nom sasi en cellule A1 deviendrait ainsi le nom de votre onglet. Pour cela,

  • Lancez l'éditeur VBA (menu "Outils/ macros/ Visual Basic Editor") ou par ALT + F11
  • CRTL + R pour accéder à VBA project en haut à gauche
  • Là double cliquez sur THISWORKBOOK
  • Placez (copiez/collez) la macro ci-dessous :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Application.ScreenUpdating = False
If Application.Intersect(Target, Range("A1")) Is Nothing Then End
ActiveSheet.Name = Target.Value
Application.ScreenUpdating = True
End Sub

A1 peut, bien entendu, être remplacé par toute autre cellule de votre choix.


Toujours ouvrir un classeur sur une feuille définie
Par défaut un classeur s'ouvrira toujours sur la dernière feuille utilisée lors de la sauvegarde. Pour que le classeur s'ouvre sur une feuille définie à l'avanceVoici une méthode qui marchera quel que soit l'utilisateur:

  • Lancez l'éditeur VBA (menu "Outils/ macros/ Visual Basic Editor") ou par ALT + F11
  • CRTL + R pour accéder à VBA project en haut à gauche
  • Là double cliquez sur THISWORKBOOK
  • Placez (copiez/collez) la macro ci-dessous :

Private Sub Workbook_Open()
Sheets("nom_de_la_feuille").Select
End Sub


Enregistrer puis fermer. Cette petite macro va s'exécuter automatiquement à l'ouverture du classeur. C'est donc la feuille dont t le nom sera écrit entre guillemets qui s'activera automatiquement quelle que soit la dernière feuille utilisée.


Compter le nombre de fois où une valeur est présente dans une feuille de calcul
Pour cela une petite macro est nécessaire. Elle est cependant très facile à mettre en oeuvre :

Dans votre feuille de calcul tapez simultanément sur ALT et F11. Visual basic s'ouvre,
Allez dans le menu "insertion/module",
Dans la fenêtre qui s'ouvre écrivez (ou copiez/collez) ce code :

Sub Compter_une_valeur()
'' Compter_une_valeur Macro
'nombre = InputBox("Inscrivez la valeur à compter", "nombre", 0)
nbre = WorksheetFunction.CountIf(Range("A:IV"), nombre)
MsgBox ("La valeur " & nombre & " est présente " & nbre & " fois dans cette feuille!!")
Range("A1").Activate

End Sub


Ouvrir Word à partir d'Excel

Voici le code de la macro à saisir :

Sub ouvrir_word()

Set ww = CreateObject("word.application")
ww.Visible = True
ww.documents.Add

End Sub


Convertir des nombres en heures

Comment transformer 15,5 en 15:30, ou comment transformer 12,3 en 12:18 ?

Il faut construire la macro suivante et l'appliquer à la zone préalablement sélectionnée dans la feuille de calcul :

Dans visual basic tapez le code :

Sub conversionheures()

Dim Answer As Long
For Each Cell In Selection
Cell.Value = (Cell.Value / 24)
Next
Selection.Numberformat = "[h]:mm"

End sub


Additionner les nombres contenus dans les cellules dont le texte est en bleu (rouge, vert, etc.)

  • Lancez l'éditeur VBA (menu "Outils/ macros/ Visual Basic Editor") ou par ALT + F11
  • CRTL + R pour accéder à VBA project en haut à gauche
  • Là double cliquez sur THISWORKBOOK
  • Placez (copiez/collez) la macro ci-dessous :

 

Sub sommeCouleurRougeText()

Dim Cellule As Range
Dim total As Variant
For Each Cellule In Selection
If Cellule.Font.ColorIndex = 5 Then '5 est le code couleur du bleu
If IsNumeric(Cellule) Then total = total + Cellule.Value
End If
Next
MsgBox total
Range("G12") = total

End Sub

Vous pouvez remplacer le code couleur en changeant son numéro sur la ligne "if Cellule.font.ColorIndex = 5 Then" le 5 est à remplacer par le code couleur souhaité (voir tableau des couleurs ci-dessous).

Avant d'éxécuter la macro, sélectionnez la plage de cellule pour laquelle vous souhaitez obtenir le total.

Vous pouvez obtenir le même résultat en testant la couleur de fond de la cellule. Pour cela remplacer
"
if Cellule.font.ColorIndex = 5" par "If Cellule.Interior.ColorIndex = 5"


Compter le nombre de cellules dont le fond est coloré en bleu (rouge, vert, etc.)

  • Lancez l'éditeur VBA (menu "Outils/ macros/ Visual Basic Editor") ou par ALT + F11
  • CRTL + R pour accéder à VBA project en haut à gauche
  • Là double cliquez sur THISWORKBOOK
  • Placez (copiez/collez) la macro ci-dessous :

Sub NombredeCellulesbleues()

Dim Cellule As Range
Dim total As Variant
For Each Cellule In Selection
If Cellule.Interior.ColorIndex = 5 Then 'bleu
total = total + Cellule.Count
End If
Next
MsgBox "Il y a " & total & " Cellules bleues"
Range("A1") = total

End Sub

 

Vous pouvez remplacer le code couleur en changeant son numéro sur la ligne "if Cellule.Interior.ColorIndex = 5 Then 'bleu" le 5 est à remplacer par le code couleur souhaité (voir tableau des couleurs ci-dessous) ainsi que le message de la boîte de dialogue sur la ligne "MsgBox "Il y a " & total & " Cellules bleues""

Avant d'éxécuter la macro, sélectionnez la plage de cellule pour laquelle vous souhaitez obtenir un décompte.

Vous pouvez obtenir le même résultat en testant la couleur du texte. Pour cela remplacer
"
If Cellule.Interior.ColorIndex = 5" par "if Cellule.font.ColorIndex = 5"


Une macro de conversion de francs vers euro et d'euros vers francs

Télécharger l'explication de la macro (format word 97 - 83ko) en cliquant ici


Convertir des majuscules en minuscules

  • Sélectionner toute la macro ci-dessous et Edition Copier
  • Ouvrer votre propre classeur
  • menu-outils-macros-Visual Basic Editor (ou ALT-F11)
  • menu-insertion-module
  • menu-Edition-coller
  • menu-fichier-Fermer et retour à Excel

Sub MinMaj()

Dim ChaineCellule As String

ChaineCellule = Selection.Value

ChaineCellule = Ucase(ChaineCellule)

Selection.Value = ChaineCellule

End Sub

 

Saisissez un texte en minuscule dans une cellule et lancez la macro. Vous pouvez aussi lui affecter un bouton dans la barre d'outils.


Convertir un nombre en lettres

  • Sélectionner toute la macro ci-dessous et Edition Copier
  • Ouvrer votre propre classeur
  • menu-outils-macros-Visual Basic Editor (ou ALT-F11)
  • menu-insertion-module
  • menu-Edition-coller
  • menu-fichier-Fermer et retour à Excel

La fonction à utiliser sera =chiffrelettre(votre cellule)

Pour un nombre en B16 : =chiffrelettre(b16)

Function chiffrelettre(s)
Dim a As Variant, gros As Variant
a = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix sept", _
"dix huit", "dix neuf", "vingt", "vingt et un", "vingt deux", "vingt trois", "vingt quatre", _
"vingt cinq", "vingt six", "vingt sept", "vingt huit", "vingt neuf", "trente", "trente et un", _
"trente deux", "trente trois", "trente quatre", "trente cinq", "trente six", "trente sept", _
"trente huit", "trente neuf", "quarante", "quarante et un", "quarante deux", "quarante trois", _
"quarante quatre", "quarante cinq", "quarante six", "quarante sept", "quarante huit", _
"quarante neuf", "cinquante", "cinquante et un", "cinquante deux", "cinquante trois", _
"cinquante quatre", "cinquante cinq", "cinquante six", "cinquante sept", "cinquante huit", _
"cinquante neuf", "soixante", "soixante et un", "soixante deux", "soixante trois", _
"soixante quatre", "soixante cinq", "soixante six", "soixante sept", "soixante huit", _
"soixante neuf", "soixante dix", "soixante et onze", "soixante douze", "soixante treize", _
"soixante quatorze", "soixante quinze", "soixante seize", "soixante dix sept", _
"soixante dix huit", "soixante dix neuf", "quatre-vingts", "quatre-vingt un", _
"quatre-vingt deux", "quatre-vingt trois", "quatre-vingt quatre", "quatre-vingt cinq", _
"quatre-vingt six", "quatre-vingt sept", "quatre-vingt huit", "quatre-vingt neuf", _
"quatre-vingt dix", "quatre-vingt onze", "quatre-vingt douze", "quatre-vingt treize", _
"quatre-vingt quatorze", "quatre-vingt quinze", "quatre-vingt seize", "quatre-vingt dix sept", _
"quatre-vingt dix huit", "quatre-vingt dix neuf")
gros = Array("", "billions", "milliards", "millions", "mille", "Euros", "billion", _
"milliard", "million", "mille", "Euro")
sp = Space(1)
chaine = "00000000000000"
centime = s * 100 - (Int(s) * 100)
s = Str(Int(s)): lg = Len(s) - 1: s = Right(s, lg): lg = Len(s)
If lg < 15 Then chaine = Mid(chaine, 1, (15 - lg)) Else chaine = ""
s = chaine + s
'billions au centaines
gp = 1
For k = 1 To 5
x = Mid(s, gp, 1): c = a(Val(x))
x = Mid(s, gp + 1, 2): d = a(Val(x))
If k = 5 Then
If t2 <> "" And c & d = "" Then mydz = "Euros" & sp: GoTo fin
If t <> "" And c = "" And d = "un" Then mydz = "un Euros" & sp: GoTo fin
If t <> "" And t2 = "" And c & d = "" Then mydz = "d'Euros" & sp: GoTo fin
If t & c & d = "" Then myct = "": mydz = "": GoTo fin
End If
If c & d = "" Then GoTo fin
If d = "" And c <> "" And c <> "un" Then mydz = c & sp & "cents " & gros(k) & sp: GoTo fin
If d = "" And c = "un" Then mydz = "cent " & gros(k) & sp: GoTo fin
If d = "un" And c = "" Then myct = IIf(k = 4, gros(k) & sp, "un " & gros(k + 5) & sp): GoTo fin
If d <> "" And c = "un" Then mydz = "cent" & sp
If d <> "" And c <> "" And c <> "un" Then mydz = c & sp & "cent" + sp
myct = d & sp & gros(k) & sp
fin:
t2 = mydz & myct
t = t & mydz & myct
mydz = "": myct = ""
gp = gp + 3
Next
d = a(centime)
If t <> "" Then myct = IIf(centime = 1, " centime", " centimes")
If t = "" Then myct = IIf(centime = 1, " centime d'Euro", " centimes d'Euro")
If centime = 0 Then d = "": myct = ""
chiffrelettre = t & d & myct
End Function

 

 


'---------------- standard ADM version 9204
'
PleinEcran()
'
EcranNormal()
' AffichageA1()
' AffichageL1C1()
' Fige()
' VersToutEnHautAGauche
' AffichagePleinEcran
' SuperGrandEcran
' VersLeHaut
' VersLeBas
' VersLaDroite
' VersLaGauche
' ClasseurPrecedent
' ClasseurSuivant
' FeuilleSuivante
' FeuillePrecedente
' FiltreOuPasFiltre()
'
CentreSurPlusieursColonnes()
'
SePositionneSurRepertoireDuFichier() <----- intéressant !


Public FlagMessage As Integer


Sub PleinEcran()
' PleinEcran Macro
' Macro enregistrée le 21/01/99 par ADM
Application.DisplayFullScreen = True
End Sub


Sub EcranNormal()
' EcranNormal Macro
' Macro enregistrée le 21/01/99 par ADM
Application.DisplayFullScreen = False
ActiveWindow.DisplayHeadings = True
ActiveWindow.Zoom = 100
End Sub


Sub AffichageA1()
' AffichageA1 Macro
' Macro enregistrée le 21/01/99 par ADM
With Application
.ReferenceStyle = xlA1
End With
End Sub


Sub AffichageL1C1()
' AffichageL1C1 Macro
' Macro enregistrée le 21/01/99 par ADM
With Application
.ReferenceStyle = xlR1C1
End With
End Sub


Sub Fige()
' ' remplace une formule par sa valeur dans une cellule

Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

End Sub


Sub VersToutEnHautAGauche()
' VersToutEnHautAGauche - Macro enregistrée le 23/01/99 par ADM

Range("C10").Select
Range("B2").Select
Range("A1").Select

End Sub


Sub AffichagePleinEcran()
' AffichagePleinEcran Macro
' Macro enregistrée le 23/01/99 par ADM
Application.DisplayFullScreen = True
End Sub


Sub SuperGrandEcran()
' SuperGrandEcran Macro
' Macro enregistrée le 24/01/99 par ADM

Application.DisplayFullScreen = True
ActiveWindow.DisplayHeadings = False
ActiveWindow.Zoom = 75

End Sub


Sub VersLeHaut()
ActiveCell.Offset(-1, 0).Range("A1").Select
End Sub


Sub VersLeBas()
ActiveCell.Offset(1, 0).Range("A1").Select
End Sub


Sub VersLaDroite()
ActiveCell.Offset(0, 1).Range("A1").Select
End Sub


Sub VersLaGauche()
ActiveCell.Offset(0, -1).Range("A1").Select
End Sub


Sub QuadrillageMasque()

ActiveWindow.DisplayGridlines = False

End Sub


Sub QuadrillageAffiche()

ActiveWindow.DisplayGridlines = True

End Sub


Sub ClasseurPrecedent()

ActiveWindow.ActivatePrevious
FlagMessage = 1
SePositionneSurRepertoireDuFichier ' *

End Sub


Sub ClasseurSuivant()

ActiveWindow.ActivateNext
FlagMessage = 1
SePositionneSurRepertoireDuFichier' *

End Sub


Sub FeuilleSuivante()
On Error GoTo Fin '
ActiveSheet.Next.Select
Exit Sub
Fin:
Beep
End Sub


Sub FeuillePrecedente()
On Error GoTo Fin '

ActiveSheet.Previous.Select

Exit Sub
Fin:

Beep

End Sub


Sub FiltreOuPasFiltre()

Selection.AutoFilter

End Sub


Sub OùSuisJe()

MsgBox (ActiveWorkbook.FullName)

End Sub


Sub CentreSurPlusieursColonnes()
' Macro enregistrée le 17/03/99 par ADM
With Selection

.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False

End With
End Sub


Sub SePositionneSurRepertoireDuFichier()
' lorsqu'on a ouvert un fichier Excel, on est positionné généralement sur le répertoire par défaut d'Excel
' avec cette macro, on se positionne sur le lecteur du fichier et sur son répertoire !
''--------------------------------------------------------
' se positionne sur le dossier du fichier courant
' si FlagMessage =1 , pas de message pour ne pas arrêter
' le déroulement de la macro appelante
'--------------------------------------------------------
NomAbsolu = ActiveWorkbook.FullName
If Mid$(NomAbsolu, 2, 1) = ":" Then

For i = Len(NomAbsolu) To 1 Step -1

If Mid$(NomAbsolu, i, 1) = "\" Then
RepAbsolu = Left(NomAbsolu, i)
i = 1
End If

Next i
ChDrive (Left(RepAbsolu, 2))
ChDir (RepAbsolu)
If FlagMessage = 0 Then Affichage = MsgBox("répertoire selectionné :" & Chr$(13) & RepAbsolu, vbInformation, "Changement de répertoire")

Else 'cas où le fichier s'appelle juste "Classeur1"

If FlagMessage = 0 Then Affichage = MsgBox("classeur non enregistré", vbExclamation, "Changement de répertoire")

End If
FlagMessage = 0
End Sub


 

Ajouter le nom complet du classeur dans le pied de page (pour édition) de la feuille

Sub nomclasseurdanspiedpage()

' Macro enregistrée le 19/07/99 par Alain DI MAGGIO

For Each F In Worksheets

F.PageSetup.CenterFooter = ActiveWorkbook.FullName

Next F

End Sub

 


Masque les lignes vides d'une sélection

Sub masquelignesvides()

' Macro enregistrée le 19/07/99 par Alain DI MAGGIO

For Each c In Selection

If Application.CountA(c.EntireRow) = 0 Then Rows(c.Row).RowHeight = 0

Next c

 

End Sub


Selectionne une plage de cellule à partir d'une cellule sélectionnée

Sub selectionplage()

' Macro enregistrée le 19/07/99 par Alain DI MAGGIO

Set Maplage = ActiveCell.CurrentRegion

Nlignes = InputBox("Nombre de lignes", , 1)

Ncolonnes = InputBox("Nombre de colonnes", , 1)

Maplage.Resize(Nlignes, Ncolonnes).Select

 

End Sub