Sommaire avec liens hypertexte, conditions et création de nouvel onglets

Bonjour,

J'aimerai créer un onglet sommaire dynamique, comprenant :

- une liste de tous les onglets qui se trouve après l'onglet "u - vierge" et seulement ceux qui commencent par "m - " (j'ai besoin de 3 onglets sommaire différent, un pour lire les onglets commençant par "u - ", "m - " & "p - ")

- donner un lien à chaque onglet trouvé

- agrandir ou rétrécir le tableau dans lequel la liste sera formé

- un bouton de création "nouvelle onglet" qui doit copier/coller les onglets "m - vierge", p - vierge" et u - vierge" en remplaçant "vierge" par le nom souhaité dans le textebox1 ("nom du chantier"), avec l'impossibilité de créer le même nom de chantier (msgbox) et trie par ordre alphabétique.

L'idée générale est de donner des liens et calculs entre les 3 onglets 'vierge" préalablement rempli pour une seule affaire et de pouvoir gérer et voir ces données seulement à partir du sommaire regroupant les onglets commençant par "m - ", un autre par "u - " et un dernier par "p - ".

J'ai déjà commencé ce projet et je bloque sur certaines fonctionnalité.

Pouvez-vous m'aider?

Merci d'avance

code du sommaire=

Private Sub worksheet_activate()
Dim ws As Worksheet, i As Integer

'pour accélération calcul
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

    i = 14
        Sheets("sommaire").Range("A14:B10000").ClearContents
            For Each ws In Application.Worksheets
               If ws.Name <> "sommaire" And ws.Name <> "sommaire" Then
                    Sheets("sommaire").Range("B" & i) = ws.Name
                    ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & i), Address:="", SubAddress:= _
                    "'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
                    i = i + 1
               End If
            Next ws

       Sheets("sommaire").Columns("a:b").EntireColumn.AutoFit

           'pour gérer le tableau changer valeur colonne
            ActiveSheet.ListObjects("Tableau_sommaire").Resize Range("$a$13:$h$" & Sheets.Count - num + 13)

'pour fin accélération calcul
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub

code de création d'onglet =

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim i As Integer
For i = 1 To Worksheets.Count
    If woorkSheets(i).Name = TextBox1.Text Then
        MsgBox ("Attention le nom du chantier existe déjà")
        GoTo saut
    Else
    End If
Next i
'copie le vierge et le renome suivant le textbox
Sheets("m - vierge").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "m - " & TextBox1.Text
Sheets("p - vierge").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "p - " & TextBox1.Text
saut:
'reinitialisation des données
TextBox1.Text = ""
TextBox1.SetFocus
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
Unload UserForm1
End Sub
Private Sub UserForm_Initialize()
'initialisation des labels
Label1.Caption = "Nom du chantier"
End Sub

et voici le fichier test

Bonjour,

1. Bouton création - Nouvel Onglet

- un bouton de création "nouvelle onglet" qui doit copier/coller les onglets "m - vierge", p - vierge" et u - vierge" en remplaçant "vierge" par le nom souhaité dans le textebox1 ("nom du chantier"), avec l'impossibilité de créer le même nom de chantier (msgbox) et trie par ordre alphabétique.

Dans votre usf, votre code création comme ceci plutôt

Private Sub CommandButton1_Click()
Dim i As Integer

Application.ScreenUpdating = False

For i = 1 To Worksheets.Count
    If Worksheets(i).Name = TextBox1.Value Then
        MsgBox ("Attention le nom du chantier existe déjà")
        With TextBox1
            .Value = ""
            .SetFocus
        End With
        Exit Sub
    End If
Next i
'copie le vierge et le renomme suivant le textbox
Sheets("m - vierge").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "m - " & TextBox1.Value
Sheets("p - vierge").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "p - " & TextBox1.Value
Sheets("u - vierge").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "u - " & TextBox1.Value

Application.ScreenUpdating = True
End Sub

Le code que vous avez posté ne crée pas de feuille u. Je l'ai rajouté.

2. Mise à jour de votre feuille Sommaire

Private Sub worksheet_Activate()
Dim ws As Worksheet, i As Integer

With Application 'pour accélération calcul
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

With Sheets("Sommaire").ListObjects("Tableau_sommaire")
    .ListColumns(2).DataBodyRange.ClearContents
    lig = .HeaderRowRange.Row
    i = 1

    For Each ws In Application.Worksheets
        If ws.Name <> "Sommaire" Then
            With .DataBodyRange
                .Hyperlinks.Add Anchor:=.Item(i, 2), Address:="", SubAddress:= _
                "'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
                i = i + 1
            End With
        End If
    Next ws

    .Range.Columns("A:B").AutoFit
    .Resize .Range.Resize(Sheets.Count)
End With

Call Trier 'tri des donnees en colonne B feuille Sommaire

'pour fin accélération calcul
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With
End Sub

3. Ajoutez cette macro dans le module de tri

Sub Trier()
With Sheets("Sommaire").ListObjects("Tableau_sommaire")
    .ListColumns(2).Range.Sort Key1:=.ListColumns(2).Range, Header:=xlYes, Order1:=xlAscending
End With
End Sub

Cordialement

Rechercher des sujets similaires à "sommaire liens hypertexte conditions creation nouvel onglets"