Brico Micro

VISUAL BASIC

- Classeur :

- Date et heure :

- Format :

- Autres :

Ajouter une fonction de calcul dans Excel :

Exemple avec une fonction permettant de calculer le prix TTC d'un produit avec une TVA de 19,6%.

Faire menu Outils / Macro / Nouvelle Macro… Taper TTC dans la zone Nom de la macro, puis cliquer dans la zone Enregistrer la macro dans sur la flèche et choisir Classeur de macros personnelles. Valider en cliquant sur le bouton OK.
Arrêter la macro sans enregistrer d'actions en cliquant sur le bouton Arrêt de la petite boite de dialogue qui s’est ouverte, puis ouvrir Visual Basic Editor depuis le menu Outils / Macro / Visual Basic Editor.
Dans la partie gauche de la fenêtre affichée, cliquer sur le signe + de +VBAProject (PERSO.XLS) puis sur le signe + de + Modules et effectuer un double-clic sur Module1.
A droite de l'écran se trouve la macro créée par Excel. L’effacer et taper à la place :

          Function TTC(nb)

Appuyer sur la touche Entrée du clavier. S’affiche alors automatiquement l'instruction terminant la fonction :

          Function TTC(nb)
          End Function

Entre ces deux lignes d'instructions saisir la ligne de commande suivante :

          TTC=nb+(nb*19.6)/100

Faire menu Fichier / Enregistrer PERSO.XLS et ensuite menu Fichier / Fermer et retourner à Microsoft Excel.
Il ne reste plus qu’à vérifier si la formule decalcul fonctionne en opérant de la même façon que pour les fonctions de Excel. La nouvelle fonction se trouve dans la Catégorie de fonctions / Personnalisées et se nomme PERSO.XLS !TTC.

Par la suite il sera toujours possible de rajouter des fonctions personnelles directement dans le Module1 de Visuel Basic Editor puisque le classeur de macros personnelles est déjà créé.

Haut de page

Utiliser les filtres sur une feuille protégée :

Lorsque l'on veut utiliser un filtre sur une feuille protégée, cela est impossible, tout du moins avec certaines versions d'Excel. Pour y remédier, procéder de le façon suivante :

Placer le filtre et protéger la feuille. Aller ensuite sur le projet VBA par Alt+F11.
Dans l' Explorateur de projets (à gauche de l'écran) cliquer deux fois sur le nom de la feuille Excel pour activer la Fenêtre Code (à droite) et y copier le code suivant :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.EnableAutoFilter = True
ActiveSheet.Protect contents:=True, userInterfaceOnly:=True
End Sub

Fermer VBE pour revenir à la feuille Excel.
Si des modifications doivent être faites par la suite il faudra supprimer le code VBA... et le recopier si besoin est.

Pour télécharger un exemple, cliquer ici.

A partir d' Excel XP cette procédure est inutile, il suffit de cocher l'autorisation Utiliser le filtre automatique depuis la boite de dialogue Protection de la feuille.

Haut de page

Date et ordre de saisie automatiques :

Pour une saisie en colonne C, le numéro d'ordre s'inscrit en colonne A et la date en colonne B.
Code à saisir dans le module Feuil :

Private Sub Worksheet_Change(ByVal Target As Range)
i = Target.Row
If Target.Column = 3 Then 'Saisie en colonne 3
Cells(i, 2).Value = Date 'Date fixée en colonne 2
Cells(i, 1).Value = Cells(i - 1, 1).Value + 1 'Numérotation en colonne 1
End If
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Date et ordre de saisie automatiques protégés :

Pour une saisie en colonne C, le numéro d'ordre s'inscrit en colonne A et la date en colonne B. Les saisies des trois colonnes sont protégées.
Code à saisir dans le module Feuil :

Private Sub Worksheet_Change(ByVal Target As Range)
i = Target.Row
If Target.Column = 3 Then 'Saisie en colonne 3
Cells(i, 2).Value = Date 'Date fixée en colonne 2
Cells(i, 1).Value = Cells(i - 1, 1).Value + 1 'Numérotation en colonne 1
ActiveSheet.Unprotect 'déproteger la feuille
Cells(i, 3).Locked = True 'verrouiller cellule saisie
Cells(i, 2).Locked = True 'verrouiller cellule date
Cells(i, 1).Locked = True 'verrouiller cellule ordre
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True 'protéger la feuille
End If
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Numérotation automatique à chaque ouverture :

Pour entrée automatique du numéro d'ordre d'ouverture du classeur en cellule A1 de la première feuille.
Code à saisir dans ThisWorkBook :

Private Sub Workbook_Open()
'numérotation dans cellule A1 de la première feuille
Worksheets(1).[A1].Value = Worksheets(1).[A1].Value + 1
'pour numérotation uniquement à l'enregistrement manuel supprimer Save
Save
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Dernière cellule non vide d'une colonne :

Pour sélectionner la dernière cellule non vide de la colonne A d'une feuille.
Code à saisir dans un Module standard :

Sub DerCel()
Range("A65534").End(xlUp).Select 'Remplacer A pour autre colonne
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Copier une feuille et la classer par ordre croissant :

Pour copier la première feuille d'un classeur et la classer par ordre croissant sur le nom des onglets (feuille - feuille (2) - feuille (3) - etc...). Nom de la feuille à adapter.
Code à saisir dans un Module standard :

Sub CopFeuil()
'pour une feuille nommée ("jour")
Sheets("jour").Select 'sélectionne la feuille 1
Sheets("jour").Copy After:=Sheets(1) 'copie la feuille 1
'trie les feuilles par ordre croissant
Dim I As Integer, J As Integer
For I = 1 To Sheets.Count
For J = 1 To I - 1
If UCase(Sheets(I).Name) < UCase(Sheets(J).Name) Then
Sheets(I).Move Before:=Sheets(J)
Exit For
End If
Next J
Next I
Sheets("jour").Select 'sélectionne la feuille 1
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Activer une macro x temps après l'ouverture du classeur :

Pour activer une macro à un instant déterminé après l'ouverture d'un classeur, saisir le code suivant dans ThisWorkBook :

Private Sub Workbook_Open()
'Effectue une action x temps après ouverture
Application.OnTime Now + TimeValue("00:00:00"), "Macrox"
'Temps à déterminer ("00:00:00")
'Macro dans Module1 "Macrox" à adapter
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Actionner une commande lors de la sélection d'une cellule :

Pour lancer une action par la seule sélection d'une cellule, saisir le code suivant dans le module Feuil :

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Address = "$B$3" Then 'clique dans cellule B3 - à adapter
Sheets("truc").Activate 'ouvre la feuille "truc" - adaptable à autre action
End If
End Sub
Private Sub Worksheet_Activate()
Range("A1").Select
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Lister les onglets d'un classeur :

Pour lister les onglets d'un classeur, dans l'ordre affiché des feuilles, saisir le code suivant dans un module standard :

Sub ListOnglets()
'Liste les onglets d'un classeur
Dim i As Integer
Dim ligne As Integer
Dim colonne As Integer
ligne = 0 'Ligne depuis laquelle on écrit (0 = rangée 1)
colonne = 1 'Colonne dans laquelle on écrit (1 =colonne A)
For i = 1 To Worksheets.Count
Cells(ligne + i, colonne).FormulaR1C1 = Worksheets.Item(i).Name
Next i
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Lister les onglets d'un classeur avec liens hypertextes :

Pour lister les onglets d'un classeur dans l'ordre affiché des feuilles avec liens permettant leur accès direct, saisir le code suivant dans un module standard :

Sub HyperOnglets()
Dim I As Integer
ActiveWorkbook.Worksheets(1).Select
ActiveSheet.Range("A2").CurrentRegion.ClearContents
For I = 2 To ActiveWorkbook.Worksheets.Count
ActiveSheet.Range("A" & I).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & Worksheets(I).Name & "'!A1", TextToDisplay:=Worksheets(I).Name
Next
Cancel = True
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Protection de toutes les feuilles d'un classeur :

Pour protéger toutes les feuilles d'un classeur saisir le code suivant :
D'une part dans un Module standard :

Sub MetProtec()
'Protège toutes les feuilles
For i = 1 To Worksheets.Count
Worksheets(i).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=""
'Empêche la sélection des cellules verrouillées - facultatif
Worksheets(i).EnableSelection = xlUnlockedCells
Next
End Sub

Si la protection est avec mot de passe, le saisir entre les "" de Password:="mot de passe"

D'autres part dans ThisWorkbook :

Private Sub Workbook_Open()
MetProtec
End Sub

Pour enlever la protection de toutes feuilles d'un classeur, saisir le code suivant dans un Module standard :

Sub SupProtec()
'Supprime la protection de toutes les feuilles
For i = 1 To Worksheets.Count
Worksheets(i).Unprotect Password:=""
Next
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Tri des feuilles d'un classeur par ordre croissant ou décroissant :

Pour trier les feuilles d'un classeur par ordre croissant, saisir le code suivant dans un Module standard :

Sub TriFeuilsCrois()
'trie les feuilles par ordre croissant
Dim I As Integer, J As Integer
For I = 1 To Sheets.Count 'pour débuter le tri à la feuille x remplacer For I = 1 pat For I = x
For J = 1 To I - 1 'pour débuter le tri à la feuille x remplacer For J = 1 par For J = x
If UCase(Sheets(I).Name) < UCase(Sheets(J).Name) Then 'pour tri décroissant remplacer < par >
Sheets(I).Move Before:=Sheets(J)
Exit For
End If
Next J
Next I
End Sub

Pour trier les feuilles d'un classeur par ordre décroissant, saisir le code ci-dessus dans un Module standard en remplaçant < par >.

Pour trier les feuilles à partir de la feuille x modifier le code For I = X To Sheets.Count et For J = X To I - 1

Pour télécharger un exemple, cliquer ici.

Haut de page

Activer la cellule contenant la date du jour lors de l'ouverture du classeur :

Pour activer la cellule contenant la date du jour lors de l' ouverture d'un classeur saisir le code suivant :
D'une part dans un Module standard :

Sub CelAujourdhui()
'sélectionne la cellule contenant la date du jour
'dans colonne 1 - à adapter
Do
Cells(i + 1, 1).Activate
If Cells(i + 1, 1) = Date Then
ActiveWindow.ScrollRow = i + 1
Exit Do
End If
i = i + 1
Loop
End Sub

D'autres part dans ThisWorkbook :

Private Sub Workbook_Open()
'à l'ouverture ouvrir Feuil1
Worksheets("Feuil1").Activate
'activer macro CelAujourdhui
CelAujourdhui
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Insertion de la date du jour dans une cellule (date figée) :

Pour insérer la date du jour dans une cellule sélectionnée, saisir le code suivant dans un Module standard :

Sub DateJour()
'Insertion date du jour
Selection = Now
End Sub

Pour insérer la date du jour dans une cellule nommée, saisir le code suivant dans un module standard :

Sub DateToday()
'Insertion date du jour
Range("today") = Now
End Sub
La date s'affichera dans la cellule ou toutes les cellules du classeur qui auront été nommées "today".

Pour insérer la date du jour par double clique dans une cellule, saisir le code suivant dans le module de feuille :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ActiveCell = Date
End Sub

Pour insérer la date du jour à l'ouverture du classeur, saisir le code suivant dans ThisWorkbook :

Private Sub Workbook_Open()
'insertion date du jour dans cellule "jour"
Range("jour") = Now
End Sub
La date s'affichera dans la cellule ou toutes les cellules du classeur qui auront été nommées "today".
L'avantage de nommer les cellules est de pouvoir affecter une macro à tout un classeur, sans avoir à la répéter.

Pour télécharger un exemple, cliquer ici.

Haut de page

Supprimer les rangées vides d'une feuille :

Pour supprimer les rangées vides intercalées d' une feuille, saisir le code suivant dans un module standard :

Sub SupRanVid()
With ActiveSheet.UsedRange
derLi = .Row + .Rows.Count - 1
End With
Application.ScreenUpdating = False
For r = derLi To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Afficher un message avec condition à l'ouverture d'un classeur :

Pour afficher un message à l' ouverture d'un classeur saisir le code suivant :
D'une part dans un Module standard :

Sub MessOuv()
'si la cellule B1 est égale à la date du jour + 5
If Range("B1") = Date + 5 Then
'montrer la fenêtre MsgBox
'& Chr(10) & permet d'aller à la ligne
MsgBox "Message pouvant être modifié depuis l'éditeur VBAProject" & Chr(10) & "Accessible dans Module1"
End If
End Sub

D'autres part dans ThisWorkbook :

Private Sub Workbook_Open()
'Sélection de la page contenant la date
Sheets("ouv").Select
'Renvoi à macro Module1
MessOuv
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Afficher un simple message à l'ouverture d'un classeur :

Pour afficher un message à l' ouverture d'un classeur saisir le code suivant dans un Module standard :

Sub auto_open()
MsgBox "bonjour"
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Afficher l' heure courante dans une cellule :

Pour afficher l' heure dans une cellule saisir le code suivant :
D'une part dans un Module standard :

Sub Horloge()
' Variables:
' "Montre.xls" nom du classeur
' "heure" nom de la feuille
' "A1" cellule affichant l'heure
 Workbooks("Montre.xls").Worksheets("heure").Range("A1") = Time
Application.OnTime Now + TimeValue("00:00:01"), "Horloge"
End Sub

D'autres part dans ThisWorkbook :

Private Sub Workbook_Open()
' "Horloge" nom de la macro à lancer à l'ouverture
Application.OnTime Now + TimeValue("00:00:01"), "Horloge"
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Ouverture d' un document Word :

Pour commander l' ouverture un document Word depuis Excel, activer préalablement la référence Microsoft Word Object Library et saisir le code suivant dans un module standard :

Sub OuvrirDocWord()
'necesite d'activer la reference Microsoft Word xx.x Object Library
'depuis le menu Outils > Références...
Dim appWrd As Word.Application
Dim docWord As Word.Document

'chemin d'accès du fichier Word à ouvrir
Fichier = "C:\Documents and Settings\GG\Bureau\OuvWord\MonWord.doc" 'A adapter

Set appWrd = CreateObject("Word.Application") 'creation session Word
appWrd.Visible = True 'pour que word soit apparent
Set docWord = appWrd.Documents.Open(Fichier)
End Sub

Pour activer la Référence Microsoft Word xx.x Object Library, depuis VBE, aller dans le menu Outils > Références...

Pour télécharger un exemple, cliquer ici et ici.

Haut de page

Modifier la casse :

Pour modifier le texte sélectionné d'une feuille de calcul en majuscules ou en minuscules.
Code à copier dans un Module standar.

Sub Majuscule()
'de miniscules à majuscules
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell
End Sub

Sub Minuscule()
'de majuscules à minuscules
For Each cell In Selection
cell.Value = LCase(cell.Value)
Next cell
End Sub


Pour une utilisation simplifiée ce code peut également être copié dans le fichier PERSO.XLS et être lié à deux boutons ajoutés à la barre d'outils.

Pour télécharger un exemple, cliquer ici.

Haut de page

Heure de saisie automatique :

Pour une saisie en colonne A, de A1 à A20, l' heure de saisie s' inscrit en colonne B..
Code à saisir dans le module Feuil :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row <= 20 Then 'saisie en colonne 1 jusqu'à rangée 20
Target.Offset(0, 1) = Format(Now, "hh:mm") 'heure affichée en colonne 2 - format modifiable
End If
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Première lettre en majuscule :

Pour mettre automatiquement la première lettre de chaque cellule en majuscule, saisir dans le module Feuil :

Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
If Target.Value >= "a" And Target.Value <= "z" Then
Target.Value = Chr(-32 + Asc(Left$(Target.Value, 1))) & Right$(Target.Value, Len(Target.Value) - 1)
End If
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Afficher les 56 couleurs de la palette des couleurs d' Excel :

Pour afficher les 56 couleurs d' Excell :avec leur code, saisir dans un module standar le code suivant :
Affiche_Couleurs pour les couleurs sans le code. Le code est défini par les numéros de rangées.
Affiche_Couleurs_Codes avec les codes.

Sub Affiche_Couleurs()
For i = 1 To 56
Cells(i, 1).Interior.ColorIndex = i
Next i
End Sub
_____________________________________________________________________________________________
Sub Affiche_Couleurs_Codes()
For i = 1 To 56
Cells(i, 1).Select
Selection.Interior.ColorIndex = i
Cells(i, 2) = i
Next i
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Mise en forme conditionnelle :

Code à utiliser lorsque la foncton Mise en forme conditionnelle d' Excel ne suffit pas. A copier dans le module de feuille et à adapter s'il y a plus de 4 conditions.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For i = 2 To 50 'rangées de 2 à 50
'condition 1
If Range("A" & i) > 0 And Range("A" & i) < 50 Then 'colonne A
Range("A" & i).Font.ColorIndex = 3 'colonne A texte Rouge
Range("B" & i).Interior.ColorIndex = 3 'colonne B cellule rouge
'condition 2
ElseIf Range("A" & i) >= 50 And Range("A" & i) < 100 Then 'colonne A
Range("A" & i).Font.ColorIndex = 5 'colonne A texte bleu
Range("B" & i).Interior.ColorIndex = 5 'colonne B cellule bleue
'condition 3
ElseIf Range("A" & i) >= 100 And Range("A" & i) < 150 Then 'colonne A
Range("A" & i).Font.ColorIndex = 4 'colonne A texte vert
Range("B" & i).Interior.ColorIndex = 4 'colonne B cellule vert
'condition 4
ElseIf Range("A" & i) >= 150 And Range("A" & i) < 200 Then 'colonne A
Range("A" & i).Font.ColorIndex = 6 'colonne B texte jaune
Range("B" & i).Interior.ColorIndex = 6 'colonne B cellule jaune
'Pour annuler la couleur des cellules vidées
ElseIf Range("A" & i) = "" Then 'colonne A
Range("A" & i).Font.ColorIndex = xlAutomatic 'colonne A texte automatique
Range("B" & i).Interior.ColorIndex = xlNone 'colonne B cellule sans couleur
End If
Next i
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Tri aléatoire :

Pour effectuer un tri aléatoire copier le code suivant dans un module standart.
Au préalable les valeurs auront été saisies en colonne B.

Sub TriAleatoire()
With Range("A1:A30") 'plage à adapter
.FormulaR1C1 = "=RAND()"
.Copy
.PasteSpecial xlPasteValues
End With
Range("A1").Sort Key1:=Range("A1") 'cellule à adapter suivant plage considérée
Range("A1").Select 'choisir cellule à sélectionner après exécution macro
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Quadrillage en centimètre :

Pour définir la dimension des rangées et des colonnes en centimètre le code suivant est à copier dans un module standard.

Pour les rangées :

Sub RangéesEnCm()
Dim cm As Single
cm = Application.InputBox("Hauteur de la rangée en cm.", Type:=1)
If cm Then
Selection.RowHeight = Application.CentimetersToPoints(cm)
End If
End Sub

Pour les colonnes :

Sub ColonnesEnCm()
Dim cm As Single, points As Single
Dim count As Single
Application.ScreenUpdating = False
cm = Application.InputBox("Largeur de la colonne en cm.", Type:=1)
If cm = False Then Exit Sub
points = Application.CentimetersToPoints(cm)
savewidth = ActiveCell.ColumnWidth
ActiveCell.ColumnWidth = 255
If points > ActiveCell.Width Then
MsgBox "La largeur de" & cm & "est trop large" & Chr(10) & _
"la valeur maxi est de " & _
Format(ActiveCell.Width / 28.3464566929134, _
"0.00"), vbOKOnly + vbExclamation, "Largeur non valable"
ActiveCell.ColumnWidth = savewidth
Exit Sub
End If
lowerwidth = 0
upwidth = 255
ActiveCell.ColumnWidth = 127.5
curwidth = ActiveCell.ColumnWidth
count = 0
While (ActiveCell.Width <> points) And (count < 20)
If ActiveCell.Width < points Then
lowerwidth = curwidth
Selection.ColumnWidth = (curwidth + upwidth) / 2
Else
upwidth = curwidth
Selection.ColumnWidth = (curwidth + lowerwidth) / 2
End If
curwidth = ActiveCell.ColumnWidth
count = count + 1
Wend
End Sub


Pour une utilisation simplifiée ce code peut également être copié dans le fichier PERSO.XLS et être lié à deux boutons ajoutés à la barre d'outils.

Pour télécharger un exemple, cliquer ici.

Haut de page

Enregistrement automatique :

Afin de ne pas perdre le contenu d'un classeur ou de ses modifications à la suite d'une fausse manœuvre il est conseillé de faire Enregistrer sous... régulièrement.
Pour éviter cette contrainte il est possible de programmer l'enregistrement à une cadence désirée.
Pour cela, copier le code suivant dans un module standard.

Public MTime As Date
Sub Reg()
MTime = Time
Application.OnTime MTime + TimeValue("00:05:00"), "Reg"
ActiveWorkbook.Save
End Sub

La durée, 5 minutes dans ce code peut être adapté à votre convenance.

Et le code suivant dans ThisWorkbook

Private Sub Workbook_Open()
Reg
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Compteur manuel :

Compteur manuel par clique dans une cellule.
Pour cela, copier le code suivant dans un module standard.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Address = "$A$1" Then 'clique en A1
i = Target.Row
Cells(i + 4, 1).Value = Cells(i + 4, 1).Value + 1 'comptage en cellule A5
[A2].Select
'deux lignes à effacer si pas de remise à 0
ElseIf Target.Address = "$B$1" Then 'clique en B1
[A5] = 0 'compteur remis à 0
End If
End Sub

D'autres possibilités de comptage dans le fichier téléchargeable.

Pour télécharger un exemple, cliquer ici.

Haut de page

Afficher une feuille en fonction du contenu d'une cellule :

Il est possible d'afficher une feuille masquée en fonction du contenu d'une cellule.
Pour cela, copier le code suivant dans un module standard.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If [A5] <> "" Then
i = Target.Row
Sheets("Feuil2").Visible = True
Else: Sheets("Feuil2").Visible = False
End If
End Sub

Dans cet exemple la feuille 2 sera affichée si la cellule A5 n'est pas vide.

Pour télécharger un exemple, cliquer ici.

Haut de page

Enregistrement à la fermeture avec ajout de la date au nom du classeur :

Il est possible d'ajouter la date du jour à la suite du nom du classeur lors de la fermeture de ce dernier, l'enregistrement se faisant automatiquement.
Pour cela, copier le code suivant dans ThisWorkbook.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
NomFichier = "EnrTest_" & Format(Now, "dd-mm-yyyy") & ".xls
ChDir "C:\Documents and Settings\GG\Bureau"
ActiveWorkbook.SaveAs Filename:=NomFichier, CreateBackup:=False
End Sub

Dans cet exemple le nom du classeur s'enregistre sous la forme EnrTest_12-07-2001.xls Le code sera donc à adapter pour:
- Le nom du classeur "EnrTest_"
- Le chemin d'accès "C:\Documents and Settings\GG\Bureau"

Pour le cas où le fichier est à enregistrer sur un lecteur externe, le code doit être adapté comme ci-dessous (exemple pour lecteur O:\ :

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
NomFichier = "EnrTest_" & Format(Now, "dd-mm-yyyy") & ".xls
ChDrive "O"
ChDir "O:\Mon dossier"
ActiveWorkbook.SaveAs Filename:=NomFichier, CreateBackup:=False
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Colorier une rangée sur deux :

Pour colorier une rangée sur deux, copier le texte suivant dans le module de feuille.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i&
Application.ScreenUpdating = False ' fige l'écran
For i = 10 To [A30].Row ' de la ligne 10 à 30 à adapter
Cells(i, 1).EntireRow.Interior.ColorIndex = 15 ' couleur gris adaptable
i = i + 1 ' à adapter si saut de plus d'une rangée
Next i
End Sub

Dans cet exemple les lignes de code 4, 5, et 6 pourront être adaptées en fonction de la mise en page choisie.
- Ligne 5: plage concernée.
- Ligne 6: Choix de la couleur. Palette des couleurs.
- Nombre de saut de ligne i = i + x.

Pour télécharger un exemple, cliquer ici.

Haut de page

Effacer le contenu d'une cellule par sélection d'une autre :

Pour effacer le contenu d'une cellule par simple clique dans une autre, le code suivant est à copier dans le module de feuille.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, [A2]) Is Nothing Then 'A2 modifiable
[B2].ClearContents 'B2 modifiable
End If
End Sub

Dans cet exemple les cellules concernées peuvent être adaptées en fonction du besoin.

Pour télécharger un exemple, cliquer ici.

Haut de page

Recalcul automatique :

Il est possible de provoquer le recalcule automatique des formules d' un classeur à des fréquences programmées.
Pour cela, copier le code suivant dans un module standard.

Public MTime As Date
Sub ReCalc()
MTime = Time
Application.OnTime MTime + TimeValue("00:00:20"), "ReCalc" ' temps à ajuster
Calculate
End Sub

La durée, 20 secondes dans ce code peut être adapté à votre convenance.

Et le code suivant dans ThisWorkbook

Private Sub Workbook_Open()
ReCalc
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Recherche dans une plage :

Ce code à copier dans le module de feuille donne les résultats d'une recherche dans une plage.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For l = 9 To 16
Cells(l, 4).Clear
Next
i = Sheets("Feuil1").Range("A65").End(xlUp).Row
For j = 2 To i
If Cells(9, 2).Value = Sheets("Feuil1").Cells(j, 1).Value Then
Cells(9 + k, 4).Value = Sheets("Feuil1").Cells(j, 2)
k = k + 1
End If
Next
End Sub

Il est bien sur à adapter et pour cela des précisions sont données sur l'exemple téléchargeable.

Pour télécharger un exemple, cliquer ici.

Haut de page

Sélectionner une plage en cliquant dans une cellule :

Pour sélectionner une rangée ou une plage en cliquant dans la première cellule, le code suivant est à copier dans le module de feuille.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column = 1 Then 'clique en colonne 1 (adaptable)
ActiveCell.Offset(0, 0).Range("A1:M1").Select 'sélection rangée de A à M (adaptable)
End If
End Sub

Dans cet exemple les cellules concernées peuvent être adaptées en fonction du besoin.

Pour télécharger un exemple, cliquer ici.

Haut de page

Activer une feuille numérotée :

Pour activer une feuille numérotée (onglets 1, 2, 3, etc...), le code suivant est à copier dans le module de feuille.

L'ordre des feuilles doit être respecté. Feuil1 est la feuille de choix, Feuil2 avec onglet 1, Feuil3 avec onglet 2, etc...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("C5") Then
Worksheets(Target.Value + 1).Activate
End If
End Sub

Pour télécharger un exemple, cliquer ici.

Haut de page

Fonctions :

Les fonctions sont à copier dans le module de Feuille entre les deux lignes suivantes:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

- Math & Trigo:

          ROMAIN
WorksheetFunction.Roman([F43], 0)

          SOMME
WorksheetFunction.Sum(Range("G5:G38"))
'ou
WorksheetFunction.Sum([G5:G38])
'ou
Evaluate("Sum(G5:G38)")

          SOMME.SI
WorksheetFunction.SumIf(Range("G5:G38"), Range("F23"))
'ou
WorksheetFunction.SumIf([G5:G38], [F23])
'ou
Evaluate("SumIf(G5:G38,F23)")

          SOMMEPROD
Evaluate("SumProduct((G5:G38 = 10) * (H5:H38 = 100))")
'ou
Evaluate("SumProduct((G5:G38 = F29) * (H5:H31 = F33))")
'ou
Evaluate("SumProduct((G5:G38 = 10) * (H5:H38 = 100))*(I5:I38)")
'ou
Evaluate("SumProduct((G5:G38 = F31) * (H5:H38 = F33))*(I5:I38)")

- Statistiques:

          GRANDE.VALEUR
WorksheetFunction.Large([H5:H38], 1)

          PETITE.VALEUR
WorksheetFunction.Small([H5:H38], 1)

          NB
WorksheetFunction.CountA(Range("G5:G38"))
'ou
WorksheetFunction.CountA([G5:G38])
'ou
Evaluate("CountA(G5:G38)")

          NB.SI
WorksheetFunction.CountIf(Range("G5:G38"), Range("F13"))
'ou
WorksheetFunction.CountIf([G5:G38], [F13])
'ou
Evaluate("CountIf(G5:G38,F13)")
'ou
WorksheetFunction.CountIf(Range("G5:G38"), 10)
'ou
WorksheetFunction.CountIf([G5:G38], 10)
'ou
Evaluate("CountIf(G5:G38,10)")

          NB.VIDE
Evaluate("COUNTBLANK(I5:I38)")

- Recherches & Matrices:

          RECHERCHE
WorksheetFunction.Lookup(9 ^ 9, [H:H])

- Dates & Heures:

          ANNEE
Evaluate("Year(G7)")

          AUJOURDHUI
Evaluate("Today()")

          HEURE
Evaluate("Hour(G21)")

          JOUR
Evaluate("Day(G7)")

          JOURSEM
Evaluate("WeekDay(G7,2)")

          JOUR360
Evaluate("Days360(G15,G7)")

          MAINTENANT
Evaluate("Now()")

          MINUTE
Evaluate("Minute(G21)")

          MOIS
Evaluate("Month(G7)")

          NO.SEMAINE
Evaluate("No.Semaine(G7,2)")

          SECONDE
Evaluate("Second(G21)")

Pour télécharger un exemple, cliquer ici.

Haut de page