|
 |

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]
|