RE Salut G'Claire
Pour la première... Tu parles de quoi ? "rajouter/supprimer un ballet entre les parties?"
On est dans quoi la feuille "Tool_Planning" tu veux effacer des lignes ?
oui pas de problème... tu peux logiquement ré-écrire dans les lignes vides ainsi... Sinon tu peux carrément supprimer des lignes... Mais n'oublie pas dans ces changements de purger les Feuilles Correpondantes en Utilsant le Bouton prévu à cet effet.
Pour La Seconde... Non, enfin non, je m'entends car tout est possible en VBA, mais là il faut tout reprendre à zéro (le code entier de génération de feuilles), et c'est vraiment du spécifique rien que pour toi, donc je n'ai ni le temps, ni vraiment l'envie de tout refaire. Par contre...
Il va falloir mettre un peu les mains dans le camboui macrobiotique...
NB Fais une copie de sauvegarde de ton fichier avant de te lancer dans la suite...
Donc je disais........ Oui Oui Par Contre... !!
Grace à Michel Pierron (MPFE) tu peux avoir une solution...
En fait (pour l'instant) on change rien de grave au macros existantes et on rajoute deux choses...
111)
Dans la macro "Sub creer_feuille()" (module1)
Tout à la fin juste avant "End Sub" tu remplace ceci :
WSBase.Activate
End Sub
Par Ceci :
SheetsSort
WSBase.Activate
End Sub
et en dessous tu laisse donc le End Sub (te plantes pas !!)
222)
Tu créés un nouveau Modul qui sera donc le Module3 et tu colles ceci :
'============================================================================
Sub SheetsSort()
'Code de Michel Pierron, mpfe
Dim id As Byte, no As Byte, ValNom(1) As Byte
Dim StrNom(1) As String
no = 1
Application.ScreenUpdating = False
Do While no < Sheets.Count
id = Sheets.Count
Do While id > no
If IsAlphaNum(Sheets(id).Name) And IsAlphaNum(Sheets(id - 1).Name) Then
StrNom(0) = Left(Sheets(id).Name, Len(Sheets(id).Name) - iPos(Sheets(id).Name))
ValNom(0) = Mid(Sheets(id).Name, Len(StrNom(0)) + 1)
StrNom(1) = Left(Sheets(id - 1).Name, Len(Sheets(id - 1).Name) - iPos(Sheets(id - 1).Name))
ValNom(1) = Mid(Sheets(id - 1).Name, Len(StrNom(1)) + 1)
Select Case StrComp(StrNom(0), StrNom(1), 1)
Case -1
Sheets(id).Move Before:=Sheets(id - 1)
Case 0
If ValNom(0) < ValNom(1) Then Sheets(id).Move Before:=Sheets(id - 1)
End Select
Else
If StrComp(Sheets(id).Name, Sheets(id - 1).Name, 1) = -1 Then
Sheets(id).Move Before:=Sheets(id - 1)
End If
End If
id = id - 1
Loop
no = no + 1
Loop
Sheets(1).Activate
Application.ScreenUpdating = True
End Sub
Private Function IsAlphaNum(NameSheet As String) As Boolean
IsAlphaNum = Not IsNumeric(NameSheet) And IsNumeric(Right(NameSheet, 1))
End Function
Private Function iPos(NameSheet As String) As Byte
iPos = 0
Do While IsNumeric(Right(NameSheet, iPos + 1))
iPos = iPos + 1
Loop
End Function
'============================================================================
Si t'es arrivé jusque là et que çà marche... Alors tu commences à être un bon !
ATTENTION ce n'est pas gagné d'avance... Les Feuilles vont se retrouvées triées de Gauche à Droite comme Ceci :
Balance 01.01
Balance 01.02
Balance 01.03
Prog 01.01
Prog 01.02
Prog 01.03
Tool Balance
Tool Prog
Tool_Planning
Faut voir si ça te convient.....
SINON... Si t'es pas content du Résultat...(ouf !!)... il y aurait une possibilité... (mais là faut que tu soies vraiment calme et patient et que tu te plantes pas car je reviendrai plus là dessus...)
Dans la macro "Sub creer_feuille()" (module1)
Tu changes les Lignes suivantes...
NewWSProg = "Prog " & Format(ItemA, "00") & "." & Format(ItemB, "00")
NewWSBce = "Balance " & Format(ItemA, "00") & "." & Format(ItemB, "00")
Par :
NewWSProg = Format(ItemA, "00") & "-" & Format(ItemB, "00") & "-P"
NewWSBce = Format(ItemA, "00") & "-" & Format(ItemB, "00") & "-B"
PAR CONTRE IL Y A ENCORE DU BOULOT ........ Et oui C'est Pas Finit, faut penser çà tout quand on modifie quelque chose !!!!!!!
Dans la macro "Private Sub UserForm_Initialize()" (Private module UserForm1)
Tu changes les Lignes suivantes...
For Each WS In Worksheets
If Left(WS.Name, 4) <> "Tool" And Left(WS.Name, 3) <> "Bal" Then
ListBox1.AddItem Right(WS.Name, 5)
End If
Next
Par :
For Each WS In Worksheets
If Right(WS.Name, 4) <> "Tool" Then
ListBox1.AddItem Left(WS.Name, 5)
End If
Next
ET ENSUITE ........ C'est PRESQUE Finit !!!!!!!
Dans la macro "Private Sub CommandButton1_Click()" (Private module UserForm1)
Tu changes :
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
Sheets("Prog " & ListBox1.List(i)).Delete
Sheets("Balance " & ListBox1.List(i)).Delete
End If
Next i
Par :
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
On Error Resume Next
Sheets(CStr(ListBox1.List(i) & "-P")).Delete
Sheets(CStr(ListBox1.List(i) & "-B")).Delete
End If
Next i
ET ENSUITE ........ C'est pratiquement Finit !!!!!!!
Dans la macro "Private Sub CommandButton2_Click()" (Private module UserForm1)
Tu Changes :
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
Sheets("Prog " & ListBox1.List(i)).PrintOut
Sheets("Balance " & ListBox1.List(i)).PrintOut
End If
Next i
Par :
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
On Error Resume Next
Sheets(CStr(ListBox1.List(i) & "-P")).PrintOut
Sheets(CStr(ListBox1.List(i) & "-B")).PrintOut
End If
Next i
Oui je sais on dirait le même code mais pas dans le même bouton et c'est pas la même instruction !!! (Delete et PrintOut ... Te Plantes Pas !)
Si tu arrives à faire tout çà sans poser de question, et bien tu rentres dans le VBA's World pour de bon !!
Bonne "Amusement", si tu respectes ce que je t'ai dit "à la lettre, je dirai même la Virgule prêt !, ce devrait être OK.
Bonne Nuit
@+Thierry
