Macro création liste des noms d'onglets

vistla · 31 Mars 2011

Bonjour Cher ami(e)s!

J'ai un fichier contenant 60+ onglets et celui-ci est évolutif. Sur une feuille, j'ai créé une macro me permettant de faire la liste de tous les onglets avec un lien hypertexte en G1. Par contre, j'aimerais que lorsqu'arrivé à G30, il continue la liste en H1, et ainsi de suite jusquà H30, I1, etc...

voici ma macro :
----
Sub Sommaire()

Dim NbFeuilles As Long
Dim NmFeuille As String
Dim Cpt As Long
Dim ExtraitNom As String
Dim NmLien As String

NbFeuilles = Worksheets.Count

Application.ScreenUpdating = False
Range("G1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents

For Cpt = 7 To NbFeuilles
NmFeuille = Sheets(Cpt).Name
ExtraitNom = (NmFeuille)
NmLien = "'" & NmFeuille & "'!A1"
Sheets("Menu").Select
Range("G1").Offset(Cpt - 7, 0).Value = ExtraitNom
ActiveSheet.Hyperlinks.Add Anchor:=Range("G1").Offset(Cpt - 7, 0), Address:="", SubAddress:=NmLien, TextToDisplay:=NmFeuille
Next Cpt
Application.ScreenUpdating = True
Range("A1").Select
End Sub

---

Je vous remercie de votre habituelle aide!

Éric

vistla · 31 Mars 2011

Re : Macro création liste des noms d'onglets

En travaillant dans le fichier, je me rend compte que pour une meilleure lecture, cette liste devrait être trié par ordre alphabétique.. je saurais comment le faire si la liste étaient sur une seule colonne, mais sur 2-3 colonnes.. ???!

suistrop · 31 Mars 2011

Re : Macro création liste des noms d'onglets

Salut,

Essai avec le code ci dessous :

Code:

Sub Sommaire()
Dim NbFeuilles As Long
Dim NmFeuille As String
Dim Cpt As Long
Dim ExtraitNom As String
Dim NmLien As String
NbFeuilles = Worksheets.Count
Application.ScreenUpdating = False
Range("G1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
ReDim tab_1(NbFeuilles - 7)
For Cpt = 7 To NbFeuilles
    ExtraitNom = Sheets(Cpt).Name
    tab_1(Cpt - 7) = ExtraitNom
Next Cpt
'On trie le tableau
For i = LBound(tab_1) To UBound(tab_1)
    lemin = i
    For y = i To UBound(tab_1)
        If tab_1(y) < tab_1(lemin) Then
            lemin = y
        End If
    Next y
    zut = tab_1(lemin)
    tab_1(lemin) = tab_1(i)
    tab_1(i) = zut
Next i
'on remet le tableau dans les cases
col = 6
ligne = 1
Sheets("menu").Select
For i = LBound(tab_1) To UBound(tab_1)
    If i Mod 30 = 0 Then
        col = col + 1
        ligne = 1
    End If
    Cells(ligne, col) = tab_1(i)
    NmLien = "'" & tab_1(i) & "'!A1"
    NmFeuille = tab_1(i)
    ActiveSheet.Hyperlinks.Add Anchor:=Range(Cells(ligne, col), Cells(ligne, col)), Address:="", SubAddress:=NmLien, _
    TextToDisplay:=NmFeuille
    ligne = ligne + 1
Next i
Application.ScreenUpdating = True
Range("A1").Select
End Sub

Suistrop

vistla · 31 Mars 2011

Re : Macro création liste des noms d'onglets

merci suistrop!

c'est merveilleux! Il ne me reste qu'à essayer de comprendre le code! À première vue, j'ai du travail 😉

Bonne journée!

Éric

Hippolite · 31 Mars 2011

Re : Macro création liste des noms d'onglets

Bonjour à tous,
Si tu ne veux pas être dépaysé, il y a cette adaptation de ton code, mais ce sera plus lent

VB:

Sub Sommaire()

Dim NbFeuilles As Long, i As Long, j As Long
Dim NmFeuille As String
Dim Cpt As Long
Dim ExtraitNom As String
Dim NmLien As String

NbFeuilles = Worksheets.Count

Application.ScreenUpdating = False
Sheets("Menu").Activate
Range("G1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
For Cpt = 7 To NbFeuilles
    NmFeuille = Sheets(Cpt).Name
    ExtraitNom = (NmFeuille)
    NmLien = "'" & NmFeuille & "'!A1"
    Sheets("Menu").Select
    Range("G1").Offset((Cpt - 7) Mod 30, j).Value = ExtraitNom
    ActiveSheet.Hyperlinks.Add Anchor:=Range("G1").Offset((Cpt - 7) Mod 30, j), Address:="", SubAddress:=NmLien, TextToDisplay:=NmFeuille
    i = i + 1
    j = Int(i / 30)
Next Cpt
Application.ScreenUpdating = True
Range("A1").Select
End Sub

A+

suistrop · 31 Mars 2011

Re : Macro création liste des noms d'onglets

Hello Hippolite,

Il voulait aussi que cela soit trié je crois.

Suistrop.

Hippolite · 1 Avril 2011

Re : Macro création liste des noms d'onglets

Re,
Je n'avais pas vu, dans ce cas, il faut trier dans un tableau à une dimension avant de répartir par paquets de 30
mais pas ce soir -> dodo
A+

Goufra · 1 Avril 2011

Re : Macro création liste des noms d'onglets

Bonsoir à toi,

Tu ne dois plus en avoir besoin !

Je t'adrresse toutefois un fichier dont les codes sont très simples
Dans module 1 et dans feuille1 pour la création initiale

tu verras si tu peux en tirer qque chose, sachant que je suis parti d'un listing pour créér mes onglets et insérer le même tableau et crééer mes liens hypertexte.
Amicalement
Goufra

vistla · 1 Avril 2011

Re : Macro création liste des noms d'onglets

bonjour suistrop, bonjour hippolite, bonjour goufra!

En fait, la personne qui va travailler avec ce fichier m'a demandé d'avoir les onglets triés. J'ai trouvé un code en faisant une recherche sur le forum et j'ai utilisé la version de Hippolite. Je réussi mieux à comprendre le code (mis à part le "MOD" qui me restera à approfondir ainsi que les variables i et j). Je n'arrive pas à comprendre le raisonnement du code de suistrop même s'il semble plus efficace..

Pour le code de goufra, quand j'ouvre le fichier, il y a un problème de macro.. j'ai pas trop approfondi avant d'écrire ce message, mais je vais essayer de corriger et voir le code.. et le comprendre si j'y arrive !

Merci à tous 😉

Bonne journée!
Éric

suistrop · 2 Avril 2011

Re : Macro création liste des noms d'onglets

Bonjour,

Le code que j'ai mis se décompose en 3 partie :

ici on met le nom de tous les onglets dans 1 tableau nommé tab_1

Code:

ReDim tab_1(NbFeuilles - 7)
For Cpt = 7 To NbFeuilles
    ExtraitNom = Sheets(Cpt).Name
    tab_1(Cpt - 7) = ExtraitNom
Next Cpt

Ici on trie le tableau :

Code:

'On trie le tableau
For i = LBound(tab_1) To UBound(tab_1)
    lemin = i
    For y = i To UBound(tab_1)
        If tab_1(y) < tab_1(lemin) Then
            lemin = y
        End If
    Next y
    zut = tab_1(lemin)
    tab_1(lemin) = tab_1(i)
    tab_1(i) = zut
Next i

On a donc un tableau avec tous les onglets dans le bon ordre.

Ici on remet le tableau dans les cases.

Code:

'on remet le tableau dans les cases
col = 6
ligne = 1
Sheets("menu").Select
For i = LBound(tab_1) To UBound(tab_1)
    If i Mod 30 = 0 Then
        col = col + 1
        ligne = 1
    End If
    Cells(ligne, col) = tab_1(i)
    NmLien = "'" & tab_1(i) & "'!A1"
    NmFeuille = tab_1(i)
    ActiveSheet.Hyperlinks.Add Anchor:=Range(Cells(ligne, col), Cells(ligne, col)), Address:="", SubAddress:=NmLien, _
    TextToDisplay:=NmFeuille
    ligne = ligne + 1
Next i

L'utilisation de "MOD" est indispensable pour affiché 30 par 30.
MOD pour modulo ca te permet d'avoir le reste de la division euclidienne.
Exemple :
1 mod 30 = 1
28 mod 30 = 28
30 mod 30 = 0 car quand tu divise 30 par 30 tu as 30*1+0
32 mod 30 = 2

Donc quand tu trouve un 0 tu sais que tu a rempli 30 lignes.

Voila j espere que c est plus clair.
On voit souvent MOD avec les nombre pair ou impair.
Soit X un nombre, X est paire ssi X mod 2 = 0.
Si X mod 2 = 1 alors X est impaire car il s'ecrit necessairement X=Y*2 + 1.

Suistrop

Nessie · 28 Septembre 2012

Re : Macro création liste des noms d'onglets

Super post et super explication suistrop !
Dans cette partie de ton code,

ReDim tab_1(NbFeuilles - 7)
For Cpt = 7 To NbFeuilles
ExtraitNom = Sheets(Cpt).Name
tab_1(Cpt - 7) = ExtraitNom
Next Cpt

quand le nombre d'onglets est indéfini comment tu l'écris :

Macro création liste des noms d'onglets

vistla

XLDnaute Junior

vistla

XLDnaute Junior

suistrop

XLDnaute Impliqué

vistla

XLDnaute Junior

Hippolite

XLDnaute Accro

suistrop

XLDnaute Impliqué

Hippolite

XLDnaute Accro

Goufra

XLDnaute Occasionnel

Pièces jointes

vistla

XLDnaute Junior

suistrop

XLDnaute Impliqué

Nessie

XLDnaute Occasionnel

Discussions similaires

Macro création liste des noms d'onglets

XLDnaute Junior

XLDnaute Junior

XLDnaute Impliqué

XLDnaute Junior

XLDnaute Accro

XLDnaute Impliqué

XLDnaute Accro

XLDnaute Occasionnel

Pièces jointes

XLDnaute Junior

XLDnaute Impliqué

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency