Adapter code compter nombre d'onglets

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

aubelix

XLDnaute Impliqué
Bonjour à tous les Amis du Forum. 🙂

J'ai trouvé un code pour compter le nombre d'onglets présents
dans mon fichier. Affichage via un message Box.

J'aurai souhaité l'adapter pour qu'une action soit exécutée que si le
nombre d'onglets est supérieur à 4.
Pourriez-vous m'aider sur la syntaxe à utiliser.

Par avance, Merci pour votre aide.
Cordialement.
 

Pièces jointes

Re : Adapter code compter nombre d'onglets

Re 🙂,
EDIT pas assez rapide toujours grillé par toi JNP !!! pour l'index j'ai pas regardé mais c'est vrai que !!
Ce n'est pas une compétition 😉...
Et je n'ai même pas mis de code modifié, donc ça ne compte pas 😛.
Par contre, j'aurais aimé une réponse d'Aubelix sur son index à partir de 5 😕
Allez, bonne journée 😎
 
Re : Adapter code compter nombre d'onglets

Bonjour JNP.
🙂
Merci pour ta remarque concernant l'index des feuilles.
J'ai un message d'erreur : Erreur de compilation, Next sans For.

J'ai dû mal placé le code que tu m'as transmis. 😕

Merci pour ton aide.
Cordialement.
 
Re : Adapter code compter nombre d'onglets

Re 🙂,
En repartant du code de Pascal
Code:
'...
'            For i = 5 To Sheets.Count
'                Sheets(i).Select
Dim Feuille As Worksheet
For Each Feuille In ThisWorkbook.Worksheets
If Feuille.Name <> "BASES" And Feuille.Name <> "REFERENCES" And Feuille.Name <> "RECHERCHE-HISTORIQUE" Then
Feuille.Select
                sNomOnglet = ActiveSheet.Range("K4").Value
                sNomOnglet = Replace(sNomOnglet, "/", "-")
                If sNomOnglet <> "" Then
                    ActiveSheet.Copy
                    'Code pour changer les "/" en "-"
                    sDossier = CheminAppli & "\" & sRacine
                    CreationDossier sDossier
                    Application.DisplayAlerts = False
                    ActiveWorkbook.SaveAs Filename:=sDossier & "\" & sNomOnglet & "  " & Format(Date, "dd_mm_yy") & "  " & Format(Time, "h-mm-ss")
                    ActiveWindow.Close
                    UserFormAttente.Label2.Caption = vbCrLf & "Export des REFS du NN :   " & ActiveSheet.Name & vbCrLf & "                Tracking List N° :   " & sNomOnglet & vbCrLf & "Vers " & CheminAppli & vbCrLf
                    'couleur de texte du Label2
                    UserFormAttente.Label2.ForeColor = &HC00000
                    UserFormAttente.Repaint
                    'Tempo de x millisecondes
                    Sleep 5
                    Calculate
                End If
'            Next i
End If
Next
'...
Bon courage 😎
 
Re : Adapter code compter nombre d'onglets

Bonjour JNP. 🙂 désolé d'avoir écorché ton pseudo.

Une autre question concernant cette macro où placer le code
pour adapter ta macro qui sert à supprimer toutes les feuilles
sauf celles nommées "BASE" , "REFERENCES" et "RECHERCHE-HISTORIQUE"
Ci-dessous le code :




Code:
Sub Supprimer()
    Dim Sh As Worksheet
 
 If Sheets.Count > 4 Then
 
 
    Select Case MsgBox("       Voulez-vous réellemnt    " _
                     & vbCrLf & "   supprimer toutes les REFS ?   " _
                     & vbCrLf & "" _
         , vbYesNo Or vbCritical Or vbDefaultButton2, "Confirmez votre choix...")
 
    Case vbYes
 
        UserFormAttente.Show 0
        UserFormAttente.Repaint
 
        Application.ScreenUpdating = False
        For Each Sh In Worksheets
 
 
Dim Feuille As Worksheet
For Each Feuille In ThisWorkbook.Worksheets
If Feuille.Name <> "BASES" And Feuille.Name <> "REFERENCES" And Feuille.Name <> "RECHERCHE-HISTORIQUE" Then
 
                          Application.DisplayAlerts = False
 
                UserFormAttente.Label2.Caption = vbCrLf & "Suppression des REFS pour le NN : " & vbCrLf & Sh.Name & vbCrLf
                UserFormAttente.Label2.ForeColor = &H400000
                UserFormAttente.Repaint
 
                'Tempo de x millisecondes
                Sleep 5
 
                Sh.Delete
 
            End If
 
        Next Sh
 
        Unload UserFormAttente
        Uf_suppression.Show 0
        Uf_suppression.Repaint
 
        Sheets("BASE").Activate
        Range("A1").Select
    Case vbNo
        Sheets("BASE").Activate
        Range("A1").Select
        Exit Sub
    End Select
 
Else
 
'        MsgBox "Vous devez lancer la macro XXXX, mais pas trop fort", , "Lancer La Macro X...."
    End If
 
 
End Sub

Merci pour ton aide.
Cordialement.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
1 K
G
Réponses
6
Affichages
2 K
Guillaume T
G
J
Réponses
11
Affichages
2 K
JEANLOUISPB
J
N
Réponses
2
Affichages
2 K
N
P
Réponses
0
Affichages
3 K
P
B
Réponses
2
Affichages
2 K
B
S
Réponses
5
Affichages
1 K
K
Réponses
0
Affichages
3 K
K
Retour