[Excel2010] - Créer un sommaire des onglets

Le 30/08/2018 à 06:05

Bonjour,

J'ai reussi à faire mettre l'onglet sommaire en 1ere position avec ceci :

'Déplacer Onglet en première position

Dim Oi As Integer

Oi = Sheets("Sommaire").Index

MsgBox ("Position de l'onglet : " & Oi)

If Oi > 1 Then

Worksheets("Sommaire").Move _

before:=Sheets(1)

End If

Je pense que c'est top là :

 Sub Sommaire()
Dim I As Integer
Dim V As Integer
Dim M As Integer
Dim C As Integer
Dim Oi As Integer

Dim newSheetName As String
Dim checkSheetName As String

    newSheetName = "Sommaire"
    On Error Resume Next
    checkSheetName = Worksheets(newSheetName).Name
    If checkSheetName = "" Then
         Worksheets.Add.Name = newSheetName
    Else
         Worksheets(newSheetName).Select
    End If

Cells.ClearContents

 'Déplacer Onglet en première position

 Oi = Sheets("Sommaire").Index
 MsgBox ("Position de l'onglet : " & Oi)
 If Oi > 1 Then
 Worksheets("Sommaire").Move _
 before:=Sheets(1)
 End If

'Titre du sommaire
Range("A1").Value = "LISTE DES ONGLETS PRESENTS DANS CE CLASSEUR"

'Date de la création du sommaire
Range("A2").Value = "Date : " & Now

'Titre : NOM DES DIFFERENTS ONGLETS
Range("B8").Value = "NOM DES DIFFERENTS ONGLETS "

'Titre Nbre
Range("A8").Value = "Nbre"

For I = 1 To Sheets.Count

        'Position de l'onglet
        Range("A" & 8 + I).Value = I
        ActiveCell.Offset(1, 0).Select

        'Nom de l'onglet : Sans lien hypertexte.
        'Range("B" & 9 + i).Select
        'ActiveCell.Value = Sheets(i).Name

        'Nom de l'onglet : Avec Lien hypertexte.
        Range("B" & 8 + I).Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
    Sheets(I).Name & "!A1", TextToDisplay:=Sheets(I).Name

        'Savoir si Onglet est Visible ou Masqu? ou Cach?
        'D?but du tableau renseignant l'?tat des onglets en C10
         Range("C" & 8 + I).Select
        'Sheets(i).Visible = -1 Veux dire Visible
        If Sheets(I).Visible = -1 Then
        Range("C" & 8 + I).Value = "Visible"
        V = V + 1
        End If
        'Sheets(i).Visible = 0 Veux dire Masqué
        If Sheets(I).Visible = 0 Then
        Range("C" & 8 + I).Value = "Masqué"
        M = M + 1
        End If
        'Sheets(i).Visible = 2 Veux dire Caché
        If Sheets(I).Visible = 2 Then
        Range("C" & 8 + I).Value = "Caché"
        C = C + 1
        End If

Next I

'Nombre total d'onglets total dans ce Classeur
Range("A3").Value = "Nombre total d'onglets visibles dans le classeur : " & Sheets.Count

'Nombre total d'onglets Visibles dans ce Classeur
Range("A4").Value = "Nombre total d'onglets visibles dans le classeur : " & V

'Nombre total d'onglets Masqu?s dans ce Classeur
Range("A5").Value = "Nombre total d'onglets masqu?s dans le classeur : " & M

'Nombre total d'onglets Cach?s dans ce Classeur
Range("A6").Value = "Nombre total d'onglets cach?s dans le classeur : " & C

'Mise en forme de la feuille
Cells.Select
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Font.Underline = xlUnderlineStyleNone
With Selection.Font
    .Name = "Calibri"
    .Size = 18
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontMinor
End With

Range("A1").Select
End Sub

Je sais pas si vous avec une idée qui serait pas mal à rajouter?

Le 30/08/2018 à 06:36

Bonjour,

tu as oublier de rétablir la gestion d'erreur :

    On Error Resume Next
    checkSheetName = Worksheets(newSheetName).Name
    On Error Goto 0

eric

Le 30/08/2018 à 08:39

Bonjour,

Ma petite contribution matinale.

ALT F8 et exécuter Create_TOC.

Cdlt.

28create-toc.xlsm (41.99 Ko)
Public Sub Create_TOC()
Dim wb As Workbook
Dim ws As Worksheet
Dim lo As ListObject
Dim a()
Dim N As Long, N2 As Long, N3 As Long, i As Long, k As Long

    Set wb = ActiveWorkbook
    Application.DisplayAlerts = False
    On Error Resume Next
    wb.Worksheets("Sommaire").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Set ws = wb.Worksheets.Add(before:=wb.Worksheets(1))
    ws.Name = "Sommaire"

    N = wb.Sheets.Count
    For i = 1 To N
        N2 = N2 + IIf(wb.Sheets(i).Visible = 0, 1, 0)
        N3 = N3 + IIf(wb.Sheets(i).Visible = 2, 1, 0)
    Next i

    With ws
        .Cells(2, 2).Value = "Liste des onglets pr?sents dans ce classeur"
        .Cells(3, 2).Value = "Date : " & FormatDateTime(Date, vbLongDate)
        .Cells(4, 2).Value = "Heure : " & FormatDateTime(Time, vbLongTime)
        .Cells(6, 2).Value = "Nombre d'onglets total": .Cells(6, 4).Value = N
        .Cells(7, 2).Value = "dont visible(s)...": .Cells(7, 4) = N - N2 - N3
        ReDim a(1 To N + 1, 1 To 4)
        a(1, 1) = "#": a(1, 2) = "Nom": a(1, 3) = "Type": a(1, 4) = "Visible"
        For i = 2 To UBound(a)
            k = k + 1
            a(i, 1) = k
            a(i, 2) = wb.Sheets(k).Name
            a(i, 3) = wb.Sheets(k).Type
            a(i, 4) = wb.Sheets(k).Visible
        Next i
        .Cells(9, 2).Resize(k + 1, 4).Value = a
        Set lo = .ListObjects.Add(xlSrcRange, .Cells(9, 2).CurrentRegion, , xlYes)
    End With

    With lo
        .Name = "T_Onglets"
        .TableStyle = "TableStyleLight8"
        .ShowAutoFilterDropDown = False
        With .ListColumns(3).DataBodyRange
            .Replace -4167, "feuille"
            .Replace 3, "graphique"
        End With
        With .ListColumns(4).DataBodyRange
            .Replace -1, "visible"
            .Replace 0, "masqu?"
            .Replace 2, "cach?"
        End With
        .HeaderRowRange.EntireColumn.AutoFit
    End With

    Columns(1).ColumnWidth = 1
    Columns(2).ColumnWidth = 3

End Sub
Le 30/08/2018 à 10:06

Bonjour,

Merci aussi Jean Eric.

J'avais essayé de l'enregistrer en macro complémentaire mais je ne la retrouvais pas dans un autre fichier.

Le 30/08/2018 à 10:46

Bonjour

déplace le sommaire en première position

A Voir

Sub Sommaire()
Dim I As Integer
Dim V As Integer
Dim M As Integer
Dim C As Integer
Dim newSheetName As String
Dim checkSheetName As String
Application.ScreenUpdating = False
    newSheetName = "Sommaire"
    On Error Resume Next
    checkSheetName = Worksheets(newSheetName).Name
    If checkSheetName = "" Then
         Worksheets.Add.Name = newSheetName
    End If
'D?placer Onglet en premi?re position
    Sheets(newSheetName).Move Before:=Sheets(1)
    Sheets(newSheetName).Select
    Cells.ClearContents
'Titre du sommaire

Range("A1").Value = "LISTE DES ONGLETS PRESENTS DANS CE CLASSEUR"

'Date de la cr?ation du sommaire
'Range("A2").Value = "Date : " & Now
    Range("A2").Value = "Date : " & DateValue(Now)
'Titre : NOM DES DIFFERENTS ONGLETS
Range("B8").Value = "NOM DES DIFFERENTS ONGLETS "

'Titre Nbre
Range("A8").Value = "Nbre"

For I = 1 To Sheets.Count

        'Position de l'onglet
        Range("A" & 8 + I).Value = I
        ActiveCell.Offset(1, 0).Select

        'Nom de l'onglet : Sans lien hypertexte.
        'Range("B" & 9 + i).Select
        'ActiveCell.Value = Sheets(i).Name

        'Nom de l'onglet : Avec Lien hypertexte.
        Range("B" & 8 + I).Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
    Sheets(I).Name & "!A1", TextToDisplay:=Sheets(I).Name

        'Savoir si Onglet est Visible ou Masqu? ou Cach?
        'D?but du tableau renseignant l'?tat des onglets en C10
         Range("C" & 8 + I).Select
        'Sheets(i).Visible = -1 Veux dire Visible
        If Sheets(I).Visible = -1 Then
        Range("C" & 8 + I).Value = "Visible"
        V = V + 1
        End If
        'Sheets(i).Visible = 0 Veux dire Masqu?
        If Sheets(I).Visible = 0 Then
        Range("C" & 8 + I).Value = "Masqu?"
        M = M + 1
        End If
        'Sheets(i).Visible = 2 Veux dire Cach?
        If Sheets(I).Visible = 2 Then
        Range("C" & 8 + I).Value = "Cach?"
        C = C + 1
        End If

Next I

'Nombre total d'onglets total dans ce Classeur
Range("A3").Value = "Nombre total d'onglets visibles dans le classeur : " & Sheets.Count

'Nombre total d'onglets Visibles dans ce Classeur
Range("A4").Value = "Nombre total d'onglets visibles dans le classeur : " & V

'Nombre total d'onglets Masqu?s dans ce Classeur
Range("A5").Value = "Nombre total d'onglets masqu?s dans le classeur : " & M

'Nombre total d'onglets Cach?s dans ce Classeur
Range("A6").Value = "Nombre total d'onglets cach?s dans le classeur : " & C

'Mise en forme de la feuille
Cells.Select
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Font.Underline = xlUnderlineStyleNone
With Selection.Font
    .Name = "Calibri"
    .Size = 18
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontMinor
End With

Range("A1").Select
End Sub

A+

Maurice

Le 30/08/2018 à 16:37

Bonjour,

Je vous remercie pour votre aide. Je vais mettre résolu. le principal est fait, me reste à soigner ma mise en forme.

Sub Sommaire()
Dim I As Integer
Dim V As Integer
Dim M As Integer
Dim C As Integer

Dim newSheetName As String
Dim checkSheetName As String

    newSheetName = "Sommaire"
    On Error Resume Next
    checkSheetName = Worksheets(newSheetName).Name
    If checkSheetName = "" Then
         Worksheets.Add.Name = newSheetName
    Else
         Worksheets(newSheetName).Select
    End If

'Déplacer Onglet en première position
Sheets(newSheetName).Move Before:=Sheets(1)
Sheets(newSheetName).Select
Cells.ClearContents

'Titre du sommaire
Range("A1").Value = "LISTE DES ONGLETS PRESENTS DANS CE CLASSEUR"

'Date de la création du sommaire
Range("A2").Value = "Date : " & Now

'Titre : NOM DES DIFFERENTS ONGLETS
Range("B8").Value = "NOM DES DIFFERENTS ONGLETS "

'Titre Nbre
Range("A8").Value = "Nbre"

For I = 1 To Sheets.Count

        'Position de l'onglet
        Range("A" & 8 + I).Value = I
        ActiveCell.Offset(1, 0).Select

        'Nom de l'onglet : Sans lien hypertexte.
        'Range("B" & 9 + i).Select
        'ActiveCell.Value = Sheets(i).Name

        'Nom de l'onglet : Avec Lien hypertexte.
        Range("B" & 8 + I).Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
    Sheets(I).Name & "!A1", TextToDisplay:=Sheets(I).Name

        'Savoir si Onglet est Visible ou Masqu? ou Cach?
        'D?but du tableau renseignant l'?tat des onglets en C10
         Range("C" & 8 + I).Select
        'Sheets(i).Visible = -1 Veux dire Visible
        If Sheets(I).Visible = -1 Then
        Range("C" & 8 + I).Value = "Visible"
        V = V + 1
        End If
        'Sheets(i).Visible = 0 Veux dire Masqué
        If Sheets(I).Visible = 0 Then
        Range("C" & 8 + I).Value = "Masqué"
        M = M + 1
        End If
        'Sheets(i).Visible = 2 Veux dire Caché
        If Sheets(I).Visible = 2 Then
        Range("C" & 8 + I).Value = "Caché"
        C = C + 1
        End If

Next I

'Nombre total d'onglets total dans ce Classeur
Range("A3").Value = "Nombre total d'onglets visibles dans le classeur : " & Sheets.Count

'Nombre total d'onglets Visibles dans ce Classeur
Range("A4").Value = "Nombre total d'onglets visibles dans le classeur : " & V

'Nombre total d'onglets Masqu?s dans ce Classeur
Range("A5").Value = "Nombre total d'onglets masqu?s dans le classeur : " & M

'Nombre total d'onglets Cach?s dans ce Classeur
Range("A6").Value = "Nombre total d'onglets cach?s dans le classeur : " & C

'Mise en forme de la feuille
Cells.Select
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Font.Underline = xlUnderlineStyleNone
With Selection.Font
    .Name = "Calibri"
    .Size = 18
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontMinor
End With

Range("A1").Select

End Sub

Merci encore et bonne journée.

Le 30/08/2018 à 17:25

Pourquoi demander si tu ne tiens pas compte des réponses ?

Ne pas rétablir le traitement d'erreur en est une grossière (d'erreur)

eric

Le 30/08/2018 à 17:35

Bonjour,

Désolé Eriic avais pas vu ton post.

    On Error Resume Next
    checkSheetName = Worksheets(newSheetName).Name
    On Error Goto 0

Ce petit morceau de code ne suffit pa pour les erreurs?

On Error Resume Next
Le 30/08/2018 à 18:53

On ne met On Error Resume Next que pour une ou quelques lignes car on sait qu'il peut survenir une erreur considérée comme 'normale'.

Mais dès que ces lignes sont passées il faut absolument rétablir le gestionnaire d'erreur avec On Error Goto 0.

Regarde l'aide excel sur On Error, elle est intéressante

Si tu fais une erreur dans ton code il faut être averti, sinon tu ne la vois pas.

Par exemple tu mets une chaine dans une variable numérique. Avec lui qui t'alerte, tu vois tout de suite que tu t'es trompé de nom de variable.

Sans lui tu pourras passer des jours à te demander pourquoi ton résultat est erroné et trouver ce style d'erreur.

Et tu n'as pas dû voir non plus la proposition de jean-eric, qui propose ta création de feuille d'une façon plus maligne et légère que la tienne.

eric

Le 30/08/2018 à 19:37

Bonsoir,

J'avais pas tout saisi le code.

J'ai lancé la version de Jean Eric et la police est plus sympa que ma version avec l'encadré.

J'aime bien ma version un peu longue en texte quand même, car si je m'y reprends dans plusieurs mois. J'aurai moins de mal à me remémorer. La version de jean Eric est concise mais je suis un peu perdu pour tout capter.

Cela sert à quoi de cherche le type cellule D9?

Je poursuis mon investigation du coups

Sub Som()
Dim I As Integer
Dim V As Integer
Dim M As Integer
Dim C As Integer

Dim newSheetName As String
Dim checkSheetName As String

    newSheetName = "Sommaire"
    On Error Resume Next
    checkSheetName = Worksheets(newSheetName).Name
    On Error GoTo 0

    If checkSheetName = "" Then
         Worksheets.Add.Name = newSheetName
    Else
         Worksheets(newSheetName).Select
    End If

'Déplacer Onglet en première position
Sheets(newSheetName).Move Before:=Sheets(1)
Sheets(newSheetName).Select
Cells.ClearContents

'Titre du sommaire
Range("A1").Value = "LISTE DES ONGLETS PRESENTS DANS CE CLASSEUR"

'Date de la création du sommaire
Range("A2").Value = "Date : " & Now

'Titre : NOM DES DIFFERENTS ONGLETS
Range("B8").Value = "NOM DES DIFFERENTS ONGLETS "

'Titre Nbre
Range("A8").Value = "Nbre"

For I = 1 To Sheets.Count

        'Position de l'onglet
        Range("A" & 8 + I).Value = I
        ActiveCell.Offset(1, 0).Select

        'Nom de l'onglet : Sans lien hypertexte.
        'Range("B" & 9 + i).Select
        'ActiveCell.Value = Sheets(i).Name

        'Nom de l'onglet : Avec Lien hypertexte.
        Range("B" & 8 + I).Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
    Sheets(I).Name & "!A1", TextToDisplay:=Sheets(I).Name

        'Savoir si Onglet est Visible ou Masqu? ou Cach?
        'D?but du tableau renseignant l'?tat des onglets en C10
         Range("C" & 8 + I).Select
        'Sheets(i).Visible = -1 Veux dire Visible
        If Sheets(I).Visible = -1 Then
        Range("C" & 8 + I).Value = "Visible"
        V = V + 1
        End If
        'Sheets(i).Visible = 0 Veux dire Masqué
        If Sheets(I).Visible = 0 Then
        Range("C" & 8 + I).Value = "Masqué"
        M = M + 1
        End If
        'Sheets(i).Visible = 2 Veux dire Caché
        If Sheets(I).Visible = 2 Then
        Range("C" & 8 + I).Value = "Caché"
        C = C + 1
        End If

Next I

'Nombre total d'onglets total dans ce Classeur
Range("A3").Value = "Nombre total d'onglets visibles dans le classeur : " & Sheets.Count

'Nombre total d'onglets Visibles dans ce Classeur
Range("A4").Value = "Nombre total d'onglets visibles dans le classeur : " & V

'Nombre total d'onglets Masqu?s dans ce Classeur
Range("A5").Value = "Nombre total d'onglets masqu?s dans le classeur : " & M

'Nombre total d'onglets Cach?s dans ce Classeur
Range("A6").Value = "Nombre total d'onglets cach?s dans le classeur : " & C

'Mise en forme de la feuille
Cells.Select
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Font.Underline = xlUnderlineStyleNone
With Selection.Font
    .Name = "Calibri"
    .Size = 18
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontMinor
End With

Range("A1").Select

End Sub

Je cherche a mettre la même police et encadré que Jean Eric j'ai un peu de mal à assimiler. J4ai bien disposer le morceau de code Goto?

Le 30/08/2018 à 20:52

Bravo, vous êtes balaises (je suis le post depuis que j'ai moi-même posté)

Mais je me dis quand même parfois que Steve Jobs avait raison

Spoiler
jobs
Le 31/08/2018 à 18:37

Bonsoir,

Je suis sur ma partie mise en forme pour encadrer mon tableau sur les lignes contenant juste le sommaire.

Je tente faire comme Jean-Eric.

Je m'y perd un peu du coup je ferai à la main ma mise en forme.

Merci à tout le monde pour votre aide.

Le 22/11/2019 à 05:57
Jean-Eric a écrit :

Bonjour,

Ma petite contribution matinale.

ALT F8 et exécuter Create_TOC.

Cdlt.

Create TOC.xlsm

Public Sub Create_TOC()
Dim wb As Workbook
Dim ws As Worksheet
Dim lo As ListObject
Dim a()
Dim N As Long, N2 As Long, N3 As Long, i As Long, k As Long

    Set wb = ActiveWorkbook
    Application.DisplayAlerts = False
    On Error Resume Next
    wb.Worksheets("Sommaire").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Set ws = wb.Worksheets.Add(before:=wb.Worksheets(1))
    ws.Name = "Sommaire"

    N = wb.Sheets.Count
    For i = 1 To N
        N2 = N2 + IIf(wb.Sheets(i).Visible = 0, 1, 0)
        N3 = N3 + IIf(wb.Sheets(i).Visible = 2, 1, 0)
    Next i

    With ws
        .Cells(2, 2).Value = "Liste des onglets pr?sents dans ce classeur"
        .Cells(3, 2).Value = "Date : " & FormatDateTime(Date, vbLongDate)
        .Cells(4, 2).Value = "Heure : " & FormatDateTime(Time, vbLongTime)
        .Cells(6, 2).Value = "Nombre d'onglets total": .Cells(6, 4).Value = N
        .Cells(7, 2).Value = "dont visible(s)...": .Cells(7, 4) = N - N2 - N3
        ReDim a(1 To N + 1, 1 To 4)
        a(1, 1) = "#": a(1, 2) = "Nom": a(1, 3) = "Type": a(1, 4) = "Visible"
        For i = 2 To UBound(a)
            k = k + 1
            a(i, 1) = k
            a(i, 2) = wb.Sheets(k).Name
            a(i, 3) = wb.Sheets(k).Type
            a(i, 4) = wb.Sheets(k).Visible
        Next i
        .Cells(9, 2).Resize(k + 1, 4).Value = a
        Set lo = .ListObjects.Add(xlSrcRange, .Cells(9, 2).CurrentRegion, , xlYes)
    End With

    With lo
        .Name = "T_Onglets"
        .TableStyle = "TableStyleLight8"
        .ShowAutoFilterDropDown = False
        With .ListColumns(3).DataBodyRange
            .Replace -4167, "feuille"
            .Replace 3, "graphique"
        End With
        With .ListColumns(4).DataBodyRange
            .Replace -1, "visible"
            .Replace 0, "masqu?"
            .Replace 2, "cach?"
        End With
        .HeaderRowRange.EntireColumn.AutoFit
    End With

    Columns(1).ColumnWidth = 1
    Columns(2).ColumnWidth = 3

End Sub

Super @Jean eric !

J'aimerais bien avoir un lien hypertexte liant chaque nom à chaque feuille.

Tu peux aider?

Le 22/11/2019 à 11:06

Bonjour,

Essaie ainsi :

Option Explicit

Public Sub Create_TOC()
Dim wb As Workbook
Dim ws As Worksheet
Dim lo As ListObject
Dim a()
Dim Cell As Range
Dim N As Long, N2 As Long, N3 As Long, i As Long, k As Long

    Set wb = ActiveWorkbook
    Application.DisplayAlerts = False
    On Error Resume Next
    wb.Worksheets("Sommaire").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Set ws = wb.Worksheets.Add(before:=wb.Worksheets(1))
    ws.Name = "Sommaire"

    N = wb.Sheets.Count
    For i = 1 To N
        N2 = N2 + IIf(wb.Sheets(i).Visible = 0, 1, 0)
        N3 = N3 + IIf(wb.Sheets(i).Visible = 2, 1, 0)
    Next i

    With ws
        .Cells(2, 2).Value = "Liste des onglets pr?sents dans ce classeur"
        .Cells(3, 2).Value = "Date : " & FormatDateTime(Date, vbLongDate)
        .Cells(4, 2).Value = "Heure : " & FormatDateTime(Time, vbLongTime)
        .Cells(6, 2).Value = "Nombre d'onglets total": .Cells(6, 4).Value = N
        .Cells(7, 2).Value = "dont visible(s)...": .Cells(7, 4) = N - N2 - N3
        ReDim a(1 To N + 1, 1 To 4)
        a(1, 1) = "#": a(1, 2) = "Nom": a(1, 3) = "Type": a(1, 4) = "Statut"
        For i = 2 To UBound(a)
            k = k + 1
            a(i, 1) = k
            a(i, 2) = wb.Sheets(k).Name
            a(i, 3) = wb.Sheets(k).Type
            a(i, 4) = wb.Sheets(k).Visible
        Next i
        .Cells(9, 2).Resize(k + 1, 4).Value = a
        Set lo = .ListObjects.Add(xlSrcRange, .Cells(9, 2).CurrentRegion, , xlYes)
    End With

    With lo
        .Name = "T_Onglets"
        .TableStyle = "TableStyleLight8"
        .ShowAutoFilterDropDown = False
        With .ListColumns(3).DataBodyRange
            .Replace -4167, "feuille"
            .Replace 3, "graphique"
        End With
        With .ListColumns(4).DataBodyRange
            .Replace -1, "visible"
            .Replace 0, "masqu?"
            .Replace 2, "cach?"
        End With
        .HeaderRowRange.EntireColumn.AutoFit
        For Each Cell In .ListColumns(2).DataBodyRange
            Cell.Hyperlinks.Add anchor:=Cell, _
                                Address:="", _
                                SubAddress:="'" & Cell.Value & "'" & "!A1"
        Next Cell
    End With

    Columns(1).ColumnWidth = 1
    Columns(2).ColumnWidth = 3

End Sub
Rechercher des sujets similaires à "excel2010 creer sommaire onglets"