Page Accueil FAQ MPFE Liens Format de nombres Téléchargement Applications Combinaisons


* * *
  SOMMAIRE
  La FAQ
  VBAXL
  BASIC
  ASTUCES
Exemples
  Boucles
  Cellules
  Cellules 2
  Divers
  Erreurs
  Fichiers
  Feuilles
  Impression
  Médias
  Messages
  Outils
  Spéciales
  Tests
  Le Web
  Userform
  XL et Word
  XL Clipboard
  XL 2007
  XL et XML
 
  Macro :o)
  Réactions
  Livre d'Or

 

titre


Les Feuilles

Nomme la feuille active avec la valeur de la plage A2

Sub NomOnglet()
Dim Name As String
Name = Range("A2")
Application.ScreenUpdating = False
ActiveSheet.Name = (Name)
End Sub

Pour toutes les feuilles

For i = 1 To Sheets.Count
With Sheets(i)
.Select
.Name = [A2]
End With
Next i

Trie les onglets des feuilles d'un fichier excel par ordre alphabétique. Première!

Type performant de procédure    ;O) à Laurent...

Sub TrieFeuilles()
Dim I As Integer
Dim J As Integer
Dim Min As Integer
Dim ModeCalcul As Integer
ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With ActiveWorkbook.Worksheets
For I = 1 To .Count - 1
Min = I
For J = I + 1 To .Count
If .Item(J).Name < .Item(Min).Name Then Min = J
Next J
If Min <> I Then .Item(Min).Move before:=Worksheets(I)
Next I
End With
Application.Calculation = ModeCalcul
Application.ScreenUpdating = True
End Sub

Trie les onglets des feuilles d'un fichier excel par ordre alphabétique. Deuxième!

Sub TriChaqueFeuilles()
Dim X As Variant
Dim I As Variant
For Each X In ActiveWorkbook.Sheets
For I = 2 To ActiveWorkbook.Sheets.Count
If Sheets(I - 1).Name > Sheets(I).Name Then
Sheets(I - 1).Move After:=Sheets(I)
End If
Next
Next
End Sub

Masque les onglets du classeur

Sub MasqueOnglet()
With ActiveWindow
.DisplayWorkbookTabs = Not .DisplayWorkbookTabs
End With
End Sub

Affiche les onglets du classeur

Sub AfficheOnglet()
ActiveWindow.DisplayWorkbookTabs = True
End Sub

2 macros, l'une masque les colonnes et lignes l'autre les affiche.

Sub MasqueColonneLigne()
On Error Resume Next
Application.ScreenUpdating = False
Numligne = InputBox(Prompt:="Taper les numéros de lignes. ( Ex. 8:12 - Maxi = 65536)")
NumColonne = InputBox(Prompt:="Taper les numéros de colonnes. ( Ex. J:D - Maxi = IV )")
Rows(Numligne).Select
Selection.EntireRow.Hidden = True
Columns(NumColonne).Select
Selection.EntireColumn.Hidden = True
End Sub

Sub AfficheLigneColonne()
[A:IV].Select
Selection.EntireRow.Hidden = False
Selection.EntireColumn.Hidden = False
Cells(1, 1).Select
End Sub

2 macros, l'une masque les en-têtes de ligne et colonne l'autre les affiche

Sub MsqEntetLigCol()
'masque les en-têtes de ligne et colonne
ActiveWindow.DisplayHeadings = False
End Sub

Sub EntetLigCol()
'affiche les en-têtes de ligne et colonne
ActiveWindow.DisplayHeadings = True
End Sub

Insere le chemin d'accés dans le pied de page.

Sub CustomFooter()
'Inserts the file name and path into the page footer
'for each sheet in the active workbook
For Each sht In ActiveWorkbook.Sheets
sht.PageSetup.LeftFooter = ActiveWorkbook.FullName
Next sht
End Sub

Donne le nom de chaque feuille du classeur.

Sub FeuilleMSG()
Dim Lst() As String
Dim I As Integer
ReDim Lst(Sheets.Count - 1)
For I = 0 To Sheets.Count - 1
Lst(I) = Sheets(I + 1).Name
MsgBox Lst(I)
Next I
End Sub

Insére 12 feuilles et les nomme suivant les 12 mois de l'année.

Sub NomFeuilMois()
For I = 1 To 12
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Format(30 * I, "mmmm")
Next I
End Sub

Supprime les feuilles vides du classeur

Sub DelFeuilleVide()
Set LaCell = ActiveCell
Set MaFeuille = ActiveWorkbook.ActiveSheet
On Error Resume Next
For Each x In ActiveWorkbook.Worksheets
x.Activate
Selection.SpecialCells(xlLastCell).Select
LeTestFeuil = False
For Each y In ActiveSheet.DrawingObjects
LeTestFeuil = True
Exit For
Next
If ActiveCell.Address = "$A$1" And IsEmpty(ActiveCell) And LeTestFeuil = False Then
Application.DisplayAlerts = False
x.Delete
Application.DisplayAlerts = True
End If
Next x
MaFeuille.Activate
LaCell.Select
End Sub

Insère une feuille nommée Liste des feuilles et crée le sommaire du classeur.

Sub ListeFeuilles()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set ArrFeuil = Sheets("Liste des feuilles")
ArrFeuil.Cells(1, 1).Value = "Tableau des feuilles"
For i = 2 To ActiveWorkbook.Sheets.Count
ArrFeuil.Cells(i, 1).Value = Sheets(i).Name
Next i
Application.DisplayAlerts = True
Alerte = True
Application.ScreenUpdating = True
End Sub

Insère une feuille et liste les feuilles sour forme de liens hypertextes.

Sub LstSheetHyperlink()
Set newfeuille = ActiveWorkbook.Sheets.Add(Type:=xlWorksheet)
For i = 1 To Sheets.Count
newfeuille.Cells(i, 1).Value = Sheets(i).Name
With Worksheets(newfeuille.Name)
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(i, 1), Address:="", SubAddress:= _
Chr(39) & Sheets(i).Name & Chr(39) & "!A1" End With
Next i
End Sub

Change le nom de la feuille active avec le texte du Presse Papier

Sub NomFeuilClipboard()
Dim FeuilObj As New DataObject
FeuilObj.GetFromClipboard
ActiveSheet.Name = FeuilObj.GetText(1)
End Sub

Insère des feuilles et les nomme suivant une liste

Créez une liste de noms et sélectionnez la avant de lancer la macro

Sub FeuilViaLst()
Dim Mycell As Range, Mysheet As Worksheet, MyName$
For Each Mycell In Selection 'liste de noms
MyName = Mycell.Value
If MyName <> "" Then
On Error Resume Next
Set Mysheet = Sheets(MyName)
On Error GoTo 0
If Mysheet Is Nothing Then Sheets.Add.Name = MyName
End If
Next Mycell
End Sub

et pour les supprimer

Sub DelFeuilViaLst()
Dim Mycell As Range, Mysheet As Worksheet, MyName$
Application.DisplayAlerts = False
For Each Mycell In Selection 'liste de noms
MyName = Mycell.Value
If MyName <> "" Then
On Error Resume Next
Set Mysheet = Sheets(MyName)
On Error GoTo 0
If Not Mysheet Is Nothing Then Sheets(MyName).Delete
End If
Next Mycell
End Sub

Tout changement du contenu d'une cellule A1 dans une feuille du classeur
modifiera automatiquement le nom de la feuille.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
If Target.Address = "$A$1" Then Sh.Name = Target
End Sub

Pour revenir à la feuille "Sommaire" lors d'un click sur l'onglet.

Programmer un événement Worksheet_Activate sur la feuille en question

Private Sub Worksheet_Activate()
ThisWorkbook.Worksheets("Sommaire").Activate
End Sub

Protége toutes les feuilles du classeur.

Sub ProtectFeuil()
Dim sht As Worksheet
Dim MotPass
MotPass = InputBox("Taper un mot de passe", 2)

For Each sht In ActiveWorkbook.Worksheets
sht.Protect Password:=(MotPass), Contents:=True, _
DrawingObjects:=True, Scenarios:=True
Next sht
End Sub

Sub UnProtectFeuil()
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Worksheets
sht.Unprotect
Next sht
End Sub

Ajout spécial XP: AllowFormattingCells:=True, AllowSorting:=True

Sub ProtectFeuilXP()
Dim sht As Worksheet
Dim MotPass
MotPass = InputBox("Taper un mot de passe", 2)

For Each sht In ActiveWorkbook.Worksheets
sht.Protect Password:=(MotPass), Contents:=True, _
DrawingObjects:=True, Scenarios:=True, _
AllowFormattingCells:=True, AllowSorting:=True
Next sht
End Sub

Quel est le type d'objet sélectionné ?

Sélectionner un objet sur la feuille "Feuil1"

Sub TypeObjet()
Worksheets("Feuil1").Activate
MsgBox "Type d'objet sélectionné " & TypeName(Selection)
End Sub

Compte le nombre de page

Sub LstNbsautPage()
'Sans saut de page vertical
MsgBox ActiveSheet.HPageBreaks.Count + 1
'+1 pour avoir le nb de pages
End Sub

'Ajoute un saut de page horizontal au-dessus de la cellule active.
ActiveSheet.HPageBreaks.Add Before:=ActiveCell

'Ajoute un saut de page vertical à gauche de la cellule active.
ActiveSheet.VPageBreaks.Add Before:=ActiveCell

Cherche une feuille et l'active

Sub cherche()
Dim maFeuil As String
On Error GoTo GestErreur
maFeuil = InputBox(Prompt:="Taper le nom de la feuille recherchée. ")
Sheets(maFeuil).Select
Range("a1").Select
Exit Sub
GestErreur:
MsgBox "Cette feuille n'existe pas !"
End Sub

Chaque jour de l'année = une feuille (soit 365 feuilles)

Sub Calendjourfeuille()
Application.ScreenUpdating = False
année = Val(InputBox("Quelle année ?"))
If année = 0 Then Exit Sub
x = DateSerial(année, 1, 1)
Y = DateValue("31 décembre " & année)
For I = 0 To Y - x
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Format(x + I, "dd-mmm-yyyy")
Next
End Sub

Chaque jour du mois = une feuille

Sub CalendParJourduMois()
Application.ScreenUpdating = False

'Date de début du mois en cours
vardate = DateSerial(Year(Now), Month(Now), 1)

'nombre de jour du mois en cours
varnb = Day(DateSerial(Year(Now), Month(Now) + 1, 0)) - 1

For I = 0 To varnb
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.[A1] = vardate + I
ActiveSheet.Name = Format([A1], "dddd dd mmmm yy")
Next I
End Sub

En A1 le nom de la feuille

Sub A1nomfeuil()
Application.ScreenUpdating = False
For Each x In ActiveWorkbook.Sheets
x.Activate
[A1] = ActiveSheet.Name
Next
End Sub

Supprime toutes les feuilles sauf la feuille "Liste"

Sub SupFeuille()
Application.DisplayAlerts = False
For I = Sheets.Count To 1 Step -1
If Sheets(I).Name = "Liste" Then
Else
Sheets(I).Delete
End If
Next
End Sub

ou bien

Sub SupFeuille2()
Application.DisplayAlerts = False
Dim W As Worksheet
For Each W In ActiveWorkbook.Worksheets
If W.Name = "liste" Then
Else: W.Delete
End If
Next W
End Sub

Calcule la somme des cellules D2 de toutes les feuilles

Sub CalculSum()
Application.ScreenUpdating = False
For Each feuille In ActiveWorkbook.Sheets
feuille.Activate
tot = [D2]
result = result + tot
Next
MsgBox result
End Sub

Masque les lignes vides de la feuille et imprime la zone en cours

Sub imprSansLigneVide()
For Each Ligne In ActiveSheet.UsedRange.Rows
If Ligne.Cells(1, 1).Value = Empty Then
'si la cellule de la colonne A est vide, la ligne est masquée
Ligne.EntireRow.Hidden = True
End If
Next
'Recherche de la derniere cellule
ActiveCell.SpecialCells(xlLastCell).Select
dercell = ActiveCell.Address

'definition de la zone d'impression
zoneIMP = Range("A1", dercell).Address

ActiveSheet.PageSetup.PrintArea = zoneIMP
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End Sub

 

Liste les feuilles dans la colonne A

Sub lstFeuille()
x = 0
Worksheets(1).Activate
For Each s In ActiveWorkbook.Sheets
x = x + 1
Cells(x, 1) = s.Name
Next
End Sub

[top]

 

     
 ©Conception et Graphisme. Daniel Josserand . Novembre 2000