Creer table matière automatique

[phil]

Bonjour,

Comment faire pour creer une feuille sous forme de Table Des Matière qui irait chercher de manière automatique le nom des feuilles suivantes et les intégrerait dans la 1ère feuille (la TDM), avec à coté le numéro de page correspondant?

y-a-t'il un moyen automatique?

Merci d'avance pour votre réponse

 

[michel]

bonsoir Phil

j'espere que la macro ci dessous répondra à ta demande

Sub CreerTableMatiere()
Dim I As Byte, J As Byte
Dim Val As String

ActiveWorkbook.Sheets.Add Before:=Worksheets(1) 'ajout nouvelle feuille
ActiveSheet.Name = "Table des matières" 'nommer la nouvelle feuille

For I = 1 To Sheets.Count 'boucler sur les feuilles du classeur
If Not ActiveSheet.Name = Sheets(I).Name Then
Val = "'" & Sheets(I).Name & "'!A1"
J = J + 1
ActiveSheet.Cells(J, 1) = J 'indexer la liste des feuilles
ActiveSheet.Hyperlinks.Add Anchor:=Cells(J, 2), Address:="", SubAddress:=Val 'creer un lien
ActiveSheet.Cells(J, 2).Hyperlinks(1).Range = Sheets(I).Name 'insérer texte dans la cellule
End If
Next I

End Sub


bonne soiree
MichelXld

 

[phil]

Impeccable, c'est tout à fait ce que je cherchais.
Un grand merci.

Encore un ch'tit renseignement : comment pouvoir afficher (à côté du n° de page et du lien vers la feuille) le contenu d'une cellule (toujours la même à chaque page, par ex. B4). En fait cette cellule contient à chaque fois la même info (différente pour chaque page, bien entendu), mais qui devrait figurer dans la table des matière.

Merci d'avance

 

[michel]

bonjour Phil

tu peux essayer

Sub CreerTableMatiere()
Dim I As Byte, J As Byte
Dim Val As String

ActiveWorkbook.Sheets.Add Before:=Worksheets(1) 'ajout nouvelle feuille
ActiveSheet.Name = "Table des matières" 'nommer la nouvelle feuille

For I = 1 To Sheets.Count 'boucler sur les feuilles du classeur
If Not ActiveSheet.Name = Sheets(I).Name Then
Val = "'" & Sheets(I).Name & "'!A1"
J = J + 1
ActiveSheet.Cells(J, 1) = J 'indexer la liste des feuilles
ActiveSheet.Hyperlinks.Add Anchor:=Cells(J, 2), Address:="", SubAddress:=Val 'creer un lien
ActiveSheet.Cells(J, 2).Hyperlinks(1).Range = Sheets(I).Name 'insérer texte dans la cellule
ActiveSheet.Cells(J, 3) = Sheets(I).Range("B4")
End If
Next I

End Sub


bonne soirée
MichelXld

 

[phil]

Un tout grand merci, c'était exactement cela.