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 Subcode 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 Subet 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 SubLe 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 Sub3. 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 SubCordialement