Classer des feuilles Excel chronologiquement

**NEC14** · 06/03/2013, 10h08

Bonjour à toutes et à tous,

J'ai le code ci-dessous qui me permet dans un ComboBox à l'intérieur d'un formulaire d'afficher le nom des feuilles de mon classeur commençant par "L".
Les onglets de mes feuilles contiennent des noms tels que L24, L12035, L343.
Elles ne sont pas classées par numéro mais par couleur (bleues pour fonctionnement, jaunes pour l'investissement).
Est-il possible de classer ces feuilles dans le Combo de manière à avoir les nombres du plus petit au plus grand ?
Merci par avance pour votre aide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Private Sub UserForm_Initialize()
Dim nbrfeuille As Long, I As Long
Application.ScreenUpdating = False
 
'je remplis ma combo avec le nom des feuilles
nbrfeuille = ActiveWorkbook.Worksheets.Count
 
    For I = 1 To nbrfeuille
          If Left(Sheets(I).Name, 1) = "L" Then 'test de  la premier lettre du nom de la feuille
               Me.CmbLigne.AddItem (ActiveWorkbook.Sheets(I).Name)
          End If
    Next I
End Sub

J'ai bien pensé à faire quelque chose comme ça et mettre le code dans ThisWorkbook, mais mon soucis est que les feuilles commencent par "L".
Qu'en pensez-vous ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub TriOngletsParNom() 
Dim I As Integer, J As Integer 
For I = 1 To Sheets.Count 
For J = 1 To I - 1 
If UCase(Sheets(I).Name) < UCase(Sheets(J).Name) Then 
Sheets(I).Move Before:=Sheets(J) 
Exit For 
End If 
Next J 
Next I 
End Sub

Invité · 06/03/2013, 10h42

Bonjour,
Si ce n’est pas exactement ce que tu souhaites, tu peux l’adapter.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Type MyOnglet
couleur As Long
name As String
End Type
 
Dim mesOnglets() As MyOnglet
ReDim mesOnglets(0)
For I = 1 To ActiveWorkbook.Worksheets.Count
 
          If Left(Sheets(I).name, 1) = "L" Then 'test de  la premier lettre du nom de la feuille
            ReDim Preserve mesOnglets(UBound(mesOnglets) + 1)
            mesOnglets(UBound(mesOnglets)).couleur = ActiveWorkbook.Sheets(I).Tab.Color
            mesOnglets(UBound(mesOnglets)).name =Ucase( ActiveWorkbook.Sheets(I).name)
 
          End If
    Next I
For I = 1 To UBound(mesOnglets)
     Me.CmbLigne.AddItem (mesOnglets(I).name)
Next
 
End Sub
Sub TrieOnglet(mesOnglets() As MyOnglet)
Dim I As Long
If UBound(mesOnglets) < 3 Then Exit Sub
For I = 2 To UBound(mesOnglets)
        If mesOnglets(I - 1).couleur > mesOnglets(I).couleur Then
        mesOnglets(0).couleur = mesOnglets(I).couleur
        mesOnglets(I).couleur = mesOnglets(I - 1).couleur
        mesOnglets(I - 1).couleur = mesOnglets(0).couleur
        If I < 3 Then
            I = I - 1
        Else
            I = I - 2
        End If
    End If
 
Next
End Sub

**NEC14** · 06/03/2013, 10h46

Bonjour rdurupt,

Merci pour ta réponse. Mais où dois-je mettre ce code, dans ThisWorkbook ou dans un module ?

Invité · 06/03/2013, 10h47

nom dans UserForm et le type dans la zone de déclaration

**NEC14** · 06/03/2013, 10h57

Ok merci. Je teste et je te tiens au courant.

QuestVba, merci pour ton code. C'est quoi CbBoxProfession ? Est-ce le nom de mon Combo que je mettre à la place ?

Invité · 06/03/2013, 11h15

Une légère absence.
Dans un nouveau module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Public Type MyOnglet
couleur As Long
name As String
End Type
Public Sub TrieOnglet(mesOnglets() As MyOnglet)
Dim I As Long
If UBound(mesOnglets) < 3 Then Exit Sub
For I = 2 To UBound(mesOnglets)
        If mesOnglets(I - 1).couleur > mesOnglets(I).couleur Then
        mesOnglets(0) = mesOnglets(I)
        mesOnglets(I) = mesOnglets(I - 1)
        mesOnglets(I - 1) = mesOnglets(0)
        If I < 3 Then
            I = I - 1
        Else
            I = I - 2
        End If
    End If
 
Next
End Sub

Dans le UserForm :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub UserForm_Initialize()
Dim mesOnglets() As MyOnglet
ReDim mesOnglets(0)
For I = 1 To ActiveWorkbook.Worksheets.Count
 
         If Left(Sheets(I).name, 1) = "L" Then 'test de  la premier lettre du nom de la feuille
            ReDim Preserve mesOnglets(UBound(mesOnglets) + 1)
            mesOnglets(UBound(mesOnglets)).couleur = ActiveWorkbook.Sheets(I).Tab.Color
             mesOnglets(UBound(mesOnglets)).name =ucase( ActiveWorkbook.Sheets(I).name)
 
          End If
    Next I
    TrieOnglet mesOnglets
For I = 1 To UBound(mesOnglets)
     Me.CmbLigne.AddItem (mesOnglets(I).name)
Next
End Sub

**PMO2017** · 06/03/2013, 11h17

Bonjour,

Est-il possible de classer ces feuilles dans le Combo de manière à avoir les nombres du plus petit au plus grand ?

Une piste avec le code suivant à mettre dans la fenêtre du UserForm concerné

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Private Sub UserForm_Initialize()
Dim nbrfeuille As Long
Dim i As Long
Dim Tbl()
Dim Compteur&
Dim A$
'---
nbrfeuille = ActiveWorkbook.Worksheets.Count
For i = 1 To nbrfeuille
  A$ = Sheets(i).Name
  If Left(A$, 1) = "L" Then 'test de  la première lettre du nom de la feuille
    Compteur& = Compteur& + 1
    ReDim Preserve Tbl(1 To Compteur&)
    Tbl(Compteur&) = Mid(A$, 2)
  End If
Next i
Call algoTri(LBound(Tbl), UBound(Tbl), Tbl)
 
'je remplis ma combo avec le nom des feuilles
For i = 1 To Compteur&
  Me.CmbLigne.AddItem ("L" & Tbl(i))
Next i
End Sub
 
Private Sub algoTri(ByVal limiteinf As Integer, ByVal limitesup As Integer, ByRef tabtri() As Variant)
Dim i%
Dim j%
Dim element
Dim transit
i% = limiteinf
j% = limitesup
transit = tabtri((limiteinf + limitesup) \ 2)
Do
  Do While tabtri(i%) < transit
    i% = i% + 1
  Loop
  Do While transit < tabtri(j%)
    j% = j% - 1
  Loop
  If i% <= j% Then
    element = tabtri(i%)
    tabtri(i%) = tabtri(j%)
    tabtri(j%) = element
    i% = i% + 1
    j% = j% - 1
  End If
Loop Until i% > j%
If limiteinf < j% Then
  Call algoTri(limiteinf, j%, tabtri)
End If
If i% < limitesup Then
  Call algoTri(i%, limitesup, tabtri)
End If
End Sub

**QuestVba** · 06/03/2013, 10h47

Bonjour

voici une petite modif

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub UserForm_Activate()
Dim Cel As Range
Dim I As Byte, J As Byte
 
For Each Sh In ThisWorkbook.Sheets
    If Left(Sh.Name, 1) = "L" Then
    Me.CbBoxProfession.AddItem Sh.Name
    End If
Next
 
 
 
With Me.CbBoxProfession
    For I = 0 To .ListCount - 1
        For J = 0 To .ListCount - 1
            If .List(I) < .List(J) Then
                strTemp = .List(I)
                .List(I) = .List(J)
                .List(J) = strTemp
                End If
        Next J
    Next I
End With
End Sub

Classer des feuilles Excel chronologiquement

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager