Astuces VBA Excel
Ø Les Classics
v compte le nombre de cellule non vide dans la colonne A
nbcells = Application.WorksheetFunction.CountA(Feuil1.Range("$A:$A"))
v Adapter la largeur d'une colonne en fonction de son contenu.
Colums("A").AutoFit
Msgbox Application.International(xlDecimalSeparator)
v Ajuster les lignes et les colonnes d'une feuille :
Pour les lignes :
Cells.EntireRow.AutoFit
Pour les colonnes :
Cells.EntireColumn.AutoFit
v Afficher un message ordinaire.
MsgBox("Bienvenu sur Excel")
v Afficher un message dans la barre de status.
Application.StatusBar="Programme en cours d'exécution ..."
v Copier les données issues d'un filtre automatique vers une autre feuille.
Sheets("Feuil1").AutoFilter.Range.Copy Sheets("Feuil2").Range("A1")
v Définir l'imprimante par défaut.
ActivePrinter="Epson 501 sur LPT1"
v Définir la ligne de titre.
ActiveSheet.PageSetUp.PrintTitleRows="$1$1"
v Eviter un message d'avertissement lorsque vous effectuer une action
Application.DisplayAlerts = False
Action(s)
Application.DisplayAlerts = True
Ø Comment accélérer significativement une macro :
1ere Etape : Permet de retirer l'affichage des étapes de la macro
Au début de la procédure mettre :
Application.ScreenUpdating = False
En fin de procédure ajouter l'instruction suivante pour permettre l'actualisation de l'affichage :
Application.ScreenUpdating = True
2nde Etape : Permet de ne pas effectuer le calcul automatique (par défault dans excel)
Désactiver le mode de calcul automatique
Application.Calculation = xlCalculationManual
Réactiver le mode de calcul automatique
Application.Calculation = xlCalculationAutomatic
Ø Tester la réponse d'un utilisateur
If MsgBox("Texte",VbYesNo,"Titre") = VbYes then
'C'est oui
else
'C'est Non
End If
Ø Utiliser les boucles dans vos macros pour automatiser au maximum votre code :
|
Jusque |
Tant que |
|
Do Until conditions |
Do While conditions |
Ø Utiliser les déplacements dans vos macros :
|
la case la plus en bas |
Selection.End(xlDown).Select |
|
la case la plus à droite |
Selection.End(xlToRight).Select |
|
la case la plus à gauche |
Selection.End(xlToLeft).Select |
|
la case la plus haute |
Selection.End(xlUp).Select |
|
Une case vers le bas |
ActiveCell.Offset(1, 0).Range("A1").Select |
|
Une case vers le haut |
ActiveCell.Offset(-1, 0).Range("A1").Select |
|
Une case vers la gauche |
ActiveCell.Offset(0, -1).Range("A1").Select |
|
Une case vers la droite |
ActiveCell.Offset(0, 1).Range("A1").Select |
Ø Utiliser l'instruction FOR...Next afin de répéter un bloc d'instructions un certain nombre de fois :
Sub BoucleFor()
For N = 1 To 10
MsgBox "Message " & N
Next N
End Sub
Explication :
"N" est un nombre qui va étre incrémenté de 1 à chaque fois que le l'instruction "Next" va être utilisée jusqu'a la valeur maximum défini par le chiffre 10
Vous pouvez égaement incrémenter différemment ou même la décrémenter utilisez le mot Step :
§ Avec le code For N = 1 To 5 Step 2, la variable N prend les valeurs 1,3 et 5.
Ø Utiliser l'instruction IF...THEN...END afin de faire réagir votre code en fonctions de vos besoins :
If condition1 Then
Instructions
Else
Instructions
End if
Explication en français :
Si la Condition 1 est vrai Alors Faire cette Instruction
Sinon Faire cette Instruction Fin de l'instruction Si
Ø Tester si un répertoire existe et si il n'existe pas le créer :
If Dir(repertoire, vbDirectory) = "" Then
MkDir repertoire
End If
Ø Colore une ligne sur deux :
Sub CouleurLignes()
Dim Ind As Boolean, LIGNE As Range
Cells.Interior.ColorIndex = xlNone
For Each LIGNE In ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows
If Ind = True Then
LIGNE.Interior.ColorIndex = 35
End If
Ind = Not Ind
Next LIGNE
End Sub
Ø Fonction permettant de calculer le nombre de samedi et de dimanche entre 2 dates :
Function NBSamDim(Debut As Date, Fin As Date)
Application.Volatile
NBSamDim = 0
For maDate = Debut To Fin
If (Weekday(maDate) = 1) Or (Weekday(maDate) = 7) Then NBSamDim = NBSamDim + 1
Next
End Function
Ø Fonction permettant de calculer une somme selon la couleur des cellules :
Function SommeVert(plage As Range)
For Each Cell In plage
If Cell.Interior.ColorIndex = 42 Then vSomme = vSomme + Cell.Value
Next
SommeVert = vSomme
End Function
Ø Divers habillage pour Excel :
v METTRE EN PLEIN ECRAN
Application.DisplayFullScreen = True
v MASQUE LES ONGLETS
ActiveWindow.DisplayWorkbookTabs = Teste
v MASQUE LES ENTETES DE LIGNE & DE COLONNE
ActiveWindow.DisplayHeadings = Teste
v MASQUE LA BARRE DE DEFILEMENT HORIZONTALE
ActiveWindow.DisplayHorizontalScrollBar = Teste
v MASQUE LA BARRE FICHIER-EDITION-AFFICHAGE...
Application.CommandBars("worksheet menu bar").Enabled = True
v MASQUE LES BARRES PAR DEFAULT D'EXCEL
Application.CommandBars("Standard").Visible = True
Application.CommandBars("Formatting").Visible = True
Ø Envoyer une messagerie avec fichier joins :
Pour que la macro fonctionne il faut sélectionner (dans l'éditeur VBA),
Menu Outils puis Références... et cocher Microsoft Outlook 12.0 Object Library.
Sub Envoi_mail_Outlook()
'-------------------------------------------------------------
'Penser a ajouter ref outlook
'-------------------------------------------------------------
Dim Adresse As String, Objet As String, Corps As String
Dim MonAppliOutlook As New Outlook.Application
Dim MonMail As Outlook.MailItem
Dim MaPièce As Outlook.Attachments
Set MonMail = MonAppliOutlook.CreateItem(olMailItem)
'-------------------------------------------------------------
'Variables
'-------------------------------------------------------------
Adresse = "adresse_mail"
Cc = "adresse_mail"
Bcc = "adresse_mail"
Objet = "Mail automatique"
Corps = "Hello," & Chr(13) & Chr(13) & "Tu trouveras ci-joint," & Chr(13) & "mon 1er mail automatique"& Chr(13) & Chr(13) & "T’en souhaitant bonne réception." & Chr(13) & "Cordialement," & Chr(13) & "TOTO"
Pièce = "CHemin_du_fichier joins" 'Application.Path & "AJoindre.jpg"
'-------------------------------------------------------------
With MonMail
.Display ' retirer le commentaire si vous voulez que le fenêtre Outlook s'affiche
.To = Adresse
If Not IsNull(Cc) Then .Cc = Cc
If Not IsNull(Bcc) Then .Bcc = Bcc
.Subject = Objet
.Body = Corps
If Not IsNull(Pièce) Then
Set MaPièce = .Attachments
MaPièce.Add Pièce, olByValue
End If
.Send
End With
'-------------------------------------------------------------
End Sub
Ø Utiliser les inputbox pour récupérer des valeurs saisies par l'utilisateur :
Msg = "Entrer l'année souhaitée (format AAAA)"
Title = "Année du traitement"
Default = "2010"
Valeur_saisie = InputBox(Msg, Title, Default)
Ø Réaliser des actions sur tous les fichiers d'un répertoire :
Sub Actions_sur_tous_les_Fichiers_du_repertoire_choisi()
Dim Wk As Object
Dim rep As Object
Dim Chemin As String, Nom_fichier As String
Dim objShell As Object, objFolder As Object, oFolderItem As Object
'-----------------------------
'choix du repertoire
'-----------------------------
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
Chemin = oFolderItem.Path
'----------------------------
' Actions sur les fichiers
'----------------------------
Set rep = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Wk In rep.Files
'ouverture du fichier
If Wk.Name <> ActiveWorkbook.Name Then Workbooks.Open Filename:=Wk
Nom_fichier = ActiveWorkbook.Name
'Actions
'fermeture
Workbooks(Nom_fichier).Close SAVECHANGES:=False
Next
End Sub
