Excel : les macros- (instructions) - outils - exemples
www.doublevez.com
Exercices EXCEL, corrections & plus...
Jean-Marc Stoeffler © maj : janvier 2007



Extrait des macros que j'utilise quotidiennement(et qui sont dans mon fichier PERSO.XLS) :


vous pouvez cliquer l'icône de votre choix...

'---------------- standard JMS 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 JMS
Application.DisplayFullScreen = True
End Sub
Sub EcranNormal()
' EcranNormal Macro
' Macro enregistrée le 21/01/99 par JMS
Application.DisplayFullScreen = False
ActiveWindow.DisplayHeadings = True
ActiveWindow.Zoom = 100
End Sub
Sub AffichageA1()
' AffichageA1 Macro
' Macro enregistrée le 21/01/99 par JMS
With Application
.ReferenceStyle = xlA1
End With
End Sub
Sub AffichageL1C1()
' AffichageL1C1 Macro
' Macro enregistrée le 21/01/99 par JMS
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 JMS

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

End Sub

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

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 JMS
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 !
' Macro proposée par Jean-Marc Stoeffler
' la révélation du 6 juin 99 (après Roland Garros 1999, mais ça n'a rien à voir)
'--------------------------------------------------------
' 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

' ****************** macro Date de fraîcheur **********************
' * Macro créée par jeanmarc.stoeffler@wanadoo.fr - 2001 *
' * pour permettre de connaitre la dernière date d'enregistrement *
' * d'un fichier Excel. (l'équivalent de DateEnreg de Word *
' *---------------------------------------------------------------*
' 4 cellules sont mises à jour automatiquement à chaque enregistrement.
' il faut prévoir dans la feuille ces 4 cellules nommées :
' - DateEnreg
' - compteur
' - DerniereFeuille
' - NomComplet
'----------------------------------------------------------- à glisser dans le ThisWorkbook : événement BeforeSave
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo Erreur
Range("DateEnreg").Value = Now()
Range("Compteur").Value = Range("compteur").Value + 1
Range("DerniereFeuille").Value = ActiveSheet.Name
Range("NomComplet").Value = ActiveWorkbook.FullName
Exit Sub
Erreur:
'facultatif...
MsgBox "gloups ! mais rien de grave... (DateEnreg ? Compteur ? DerniereFeuille ?"
End Sub

' pour avoir une trace de chaque enregistrement, il suffit de faire descendre
' automatiquement les noms d'une ligne, mais ça c'est une autre affaire
par JMS