Planing : Récupération d'une liste des noms présents dans tous les onglets

E

Emmanuel31

XLDnaute Occasionnel
Bonjour à tous :cool:

Me voici de retour avec un fichier de planning que je me créé actuellement.
Le principe :
- 1 onglet par mois -> OK :)
- mise en forme automatique des week-ends et jours fériés -> OK :)
- mise en forme automatique des noms (tri dans chaque onglet par ordre alphabétique) -> OK :)
- coloriage des cellules en fonction du contenu -> OK :)

Là ou je bug :
- erreur lors de la remise à 0 via le bouton (du au tri de la mise en forme automatique des noms) ... ça marchait avant que je mette ce tri de noms ... :mad:

Ce que je souhaiterais ajouter :
- récupération dans tous les onglets de mois de la liste des noms afin d'alimenter seul l'onglet "Outils" :eek:

Pouvez-vous m'aider svp :confused:

Ci-joint mon fichier.

PS : si vous voyez des améliorations ou des bugs, n'hésitez pas (j'avais déjà pensé à mettre le code de coloration des cellules dans le "this workbook" au lieu de dans chaque onglet (or Outils et Paramètres) mais je n'y arrive pas ...

Merci ;)
 

Pièces jointes

  • Planning_vierge.xls
    252.5 KB · Affichages: 61
Trier par date Trier par votes
Odesta

Odesta

XLDnaute Impliqué
Re : Planing : Récupération d'une liste des noms présents dans tous les onglets

Bonjour
Jolie planning !

Votre erreur vient de la macro TriNoms, qui est lancée par la modification de chaque feuille. Hors, la feuille active à ce moment est la feuille "Outils", donc le programme cherche à modifier cette feuille et ne peut pas à cause des cellules fusionnées.

Je propose donc, pour chaque feuille de modifier l'appel de TriNoms :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
      coloration Target

      Call TriNoms(Target.Worksheet.Name)
End Sub
et de modifier en conséquance la fonction :
VB: 
Sub TriNoms(feuille As String)
If feuille <> "Outils" And feuille <> "Paramètres" Then
Sheets(feuille).Unprotect
Application.ScreenUpdating = False

Sheets(feuille).Range("A4:AG23").Sort Key1:=Sheets(feuille).Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Sheets(feuille).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True
End If
End Sub


A vous de jouer !


Cdt
Olivier
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Re : Planing : Récupération d'une liste des noms présents dans tous les onglets

Bonjour aux deux.
Heureusement qu'il y avait une cellule fusionnée dans votre feuille Outils qui empêchait de la trier !
Ça me flanquerait une peur rétrospective qui me pousserait à passer la Worksheet en paramètre à votre TriNoms et à l'y préciser en qualificateur de la méthode Range
À part ça, inutile d'utiliser Run pour les procédures Public internes au projet VBA. Simplement le nom de la Sub ça suffit. Donc:
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
      coloration Target
      TriNoms Me
End Sub
VB: 
Sub TriNoms(Feui As Worksheet)
Feui.Unprotect
Application.ScreenUpdating = False

Application.EnableEvents = False
Feui.Range("A4:AG23").Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.EnableEvents = True

Feui.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True
End Sub
Le plus important: en tête de votre Sub RAZ mettez:
VB: 
Application.EnableEvents = False
pour ne plus exécuter les Worksheet_Change induits.
À remettre à True à la fin, très important !
À+
 
Dernière édition:
Vote positif 0 Vote négatif
E

Emmanuel31

XLDnaute Occasionnel
Re : Planing : Récupération d'une liste des noms présents dans tous les onglets

Merci Odesta (Olivier) ... comme d'habitude ton aide est précieuse !

Dranreb je n'ai pas compris ton intervention par contre (pardon je ne suis pas un pro en vba ni excel ... :( )

Voici donc le fichier à jour et fonctionnant bien pour la remise à zéro ...

Sinon, une idée sur les points suivant :
- centraliser le code pour éviter de le mettre dans tous les onglets de mois (mais sans qu'il ne s’exécute sur les onglets "Outils" et "Paramètres") :confused:
- Récupérer les noms dans tous les onglets pour les centraliser dans l'onglet Outils (évite la saisie afin que tout soit automatique) :confused:

edit : modification du fichier en v3 (le 29 février ne s'affiche que quand il existe)
 

Pièces jointes

  • Planning_vierge_v3.xls
    252 KB · Affichages: 49
Dernière édition:
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Re : Planing : Récupération d'une liste des noms présents dans tous les onglets

Personnellement je renommerais dans les propriétés les CodesNames des deux feuilles à exclure en "FOutils" et "FParams" et j'écrirais dans ThisWorkbook:
VB: 
Option Explicit
'

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> FOutils.Name And Sh.Name <> FParams.Name Then Coloration Target: TriNoms Sh
End Sub
'

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> FOutils.Name And Sh.Name <> FParams.Name Then TriNoms Sh
End Sub
'

Sub Coloration(Cellule As Range)
Dim L As Long
On Error Resume Next
L = WorksheetFunction.Match(Cellule.Value, FParams.[Code], 0)
If Err Then
   Cellule.Interior.ColorIndex = FParams.[Nontrouvé].Interior.ColorIndex
Else
   Cellule.Interior.ColorIndex = FParams.[Code].Cells(L, 2).Interior.ColorIndex
   End If
End Sub

P.S. dans ma réponse précédente préciser ByVal As Worksheet comme paramètre de TriNoms

À+
 
Dernière édition:
Vote positif 0 Vote négatif
Odesta

Odesta

XLDnaute Impliqué
Re : Planing : Récupération d'une liste des noms présents dans tous les onglets

Voila un 'petit' code permettant de rajouter les noms des différents onglets sur la feuille Outils.
Attention : la mise en forme est détruite !

Il faut rajouter un bouton dans l'onglet Outils (il y a d'autre méthode, je te laisse adapter)

Lui mettre ce petit code :
VB: 
Private Sub CommandButton2_Click()
Call recup_sommes
End Sub

Et le code correspondant dans "Macros"

VB: 
Sub recup_sommes()

'remettre à 0 le compteur :
For y = 10 To 29
    Sheets("Outils").Cells(y, 1).Clear
    Sheets("Outils").Cells(y, 3).Clear
Next y


For Each feuille In Sheets
    If feuille.Name <> "Outils" And feuille.Name <> "Paramètres" Then
        For i = 4 To 23
            nom_actu = feuille.Cells(i, 1).Value
            If nom_actu <> "" Then
                nom_trouve = False
                'chercher valeur dans l'onglet outils
                For y = 10 To 29
                    If nom_actu = Sheets("Outils").Cells(y, 1).Value Then
                    'nom trouvé : ajouter
                    nom_trouve = True
                    Sheets("Outils").Cells(y, 3).Value = Sheets("Outils").Cells(y, 3).Value + feuille.Cells(i, 2).Value
                    End If
                Next y
                If nom_trouve = False Then
                    'si aucune correspondance : ajouter
                    y = 10
                    nom_ajoute = False
                    While nom_ajoute = False And y <= 23 'vérifier de ne pas dépasser la ligne 23
                        If Sheets("Outils").Cells(y, 1).Value <> "" Then
                            y = y + 1 'ligne suivante
                        Else
                            'ajouter ici
                            Sheets("Outils").Cells(y, 1).Value = feuille.Cells(i, 1).Value
                            Sheets("Outils").Cells(y, 3).Value = feuille.Cells(i, 2).Value
                            nom_ajoute = True 'sortie de la boucle
                        End If
                    Wend
                End If
            End If
        Next i
    End If
Next
End Sub

Est-ce adapté au besoin ?

cdt
Olivier
 
Vote positif 0 Vote négatif
E

Emmanuel31

XLDnaute Occasionnel
Re : Planing : Récupération d'une liste des noms présents dans tous les onglets

@Dranreb : Merci, ça fonctionne désormais directement depuis 1 code centralisé sur le "ThisWorkBook" ... mais j'ai du modifier ton code en remplaçant les "TriNoms Sh" qui ne fonctionnait pas par "Call TriNoms(Target.Worksheet.Name)"

@Olivier : Merci aussi. Ça fonctionne mais effectivement ça perds la mise en forme :(
De plus , le calcul automatique n'est pas nécessaire car j'avais mis la formule suivante (quelque peu barbare je vous l'accorde mais qui fonctionne) :
Code: 
=SOMME.SI(Jan!A:A;CONCATENER("=";A10);Jan!B:B)+SOMME.SI(Fev!A:A;CONCATENER("=";A10);Fev!B:B)+SOMME.SI(Mar!A:A;CONCATENER("=";A10);Mar!B:B)+SOMME.SI(Avr!A:A;CONCATENER("=";A10);Avr!B:B)+SOMME.SI(Mai!A:A;CONCATENER("=";A10);Mai!B:B)+SOMME.SI(Juin!A:A;CONCATENER("=";A10);Juin!B:B)+SOMME.SI(Juil!A:A;CONCATENER("=";A10);Juil!B:B)+SOMME.SI(Aou!A:A;CONCATENER("=";A10);Aou!B:B)+SOMME.SI(Sep!A:A;CONCATENER("=";A10);Sep!B:B)+SOMME.SI(Oct!A:A;CONCATENER("=";A10);Oct!B:B)+SOMME.SI(Nov!A:A;CONCATENER("=";A10);Nov!B:B)+SOMME.SI(Dec!A:A;CONCATENER("=";A10);Dec!B:B)

Ça à le mérite d'être dynamique ...

Je vais essayer de voir comment faire pour :
- supprimer dans ton code la partie "comptage"
- garder la mise en forme
- que ce soit automatique et non via un bouton de mise à jour ...
 
Vote positif 0 Vote négatif
G

Guest

Guest
Re : Planing : Récupération d'une liste des noms présents dans tous les onglets

Bonjour tous,

Voici encore une autre proposition. Toutes les macros sont dans le module "Macros".

Dans le module "Macros" trois constantes on été crées avec les adresses de plage à traiter dans les différentes macros.

J'ai renommé "CodeNames" des feuilles 'Outils' et 'Paramètres' en 'Outils' et 'Params'

Dans ThisWorkbook

La distinction des feuilles se fait par

If Sh.Name <> Outils.Name And Sh.Name <> Params.Name Then...

La macro coloration n'est lancée que si la cellule changée est dans la plage correspondant à la constante AdrCellCoul (C4:AG23)

Le macro de tri n'est lancée que si la cellule changée est dans la plage correspondant à la constante AdrNoms (A4:A23)

Si ton tableau évolue, tu n'auras plus qu'à changer la valeur des constantes pour que tes macros retrouve ses petits.

Dans la feuille 'Outils' j'ai un peu changé ta formule de somme. Peut sans doute être encore amélioré, voir avec un formuliste.

A+ à tous
 
Vote positif 0 Vote négatif
E

Emmanuel31

XLDnaute Occasionnel
Re : Planing : Récupération d'une liste des noms présents dans tous les onglets

Bonjour Hasco.

J'ai regardé ton fichier et quelque chose me chagrine :
- la coloration automatique en fonctionne plus (pour les 1 c m r etc ...) -> résolu, ça venait du bug de RAZ ci-dessous ... si je fais pas de RAZ, ça amrche bien
- bug lors de la remise à zéro dans la fonction TriNoms au niveau de
Code: 
    Range(AdrTableau).Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
                           OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
- pas d'intégration automatique des noms de tous les onglets dans l'onglet "Outils"

Penses-tu que ça puisse venir de ma version d'excel ?
 
Dernière édition:
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Re : Planing : Récupération d'une liste des noms présents dans tous les onglets

mais j'ai du modifier ton code en remplaçant les "TriNoms Sh" qui ne fonctionnait pas par "Call TriNoms(Target.Worksheet.Name)"
Cliquez pour agrandir...
Ça devrait fonctionner si TriNoms est écrit comme ça:
VB: 
Sub TriNoms(ByVal Feui As Worksheet)
Feui.Unprotect
Application.ScreenUpdating = False

Application.EnableEvents = False
Feui.Range("A4:AG23").Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.EnableEvents = True

Feui.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True
End Sub
On peut toujours éviter de passer par les noms des objets en transmettant directement les objets eux même. Et c'est toujours mieux: les objets ainsi passés peuvent être utilisés directement.
À+
 
Vote positif 0 Vote négatif
E

Emmanuel31

XLDnaute Occasionnel
Re : Planing : Récupération d'une liste des noms présents dans tous les onglets

Dranreb à dit:
Ça devrait fonctionner si TriNoms est écrit comme ça:
VB: 
Sub TriNoms(ByVal Feui As Worksheet)
Feui.Unprotect
Application.ScreenUpdating = False

Application.EnableEvents = False
Feui.Range("A4:AG23").Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.EnableEvents = True

Feui.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True
End Sub
On peut toujours éviter de passer par les noms des objets en transmettant directement les objets eux même. Et c'est toujours mieux: les objets ainsi passés peuvent être utilisés directement.
À+
Cliquez pour agrandir...

Yep ça marche !!!!
Merci ...

il ne me reste plus que la partie récupération des noms dans l'onglet "Outils" du coup ... ^^
 
Vote positif 0 Vote négatif
G

Guest

Guest
Re : Planing : Récupération d'une liste des noms présents dans tous les onglets

RE,

Si la macro coloration ne marche pas c'est probablement parcequ'un Application.EnableEvents a été mis à False sans être remis à True. (Macro TriNoms)

Par contre dans ton fichier exemple il n'y avait pas de nom 'Nomtrouvé' alors j'en ai créer un : NomTrouvé=Paramètres!$A$17

Nous ne pouvions nous en rendre compte, justement à cause du on error resume next

Nouvelle macro Coloration qui évite la boucle for et le on error resume next
VB: 
Sub coloration(cellule)
    Dim idx As Variant
    idx = Application.Match(cellule.Value, Params.Range("Code"), 0)
    If Not IsError(idx) Then
        cellule.Interior.ColorIndex = Params.Range("Code").Cells(idx, 2).Interior.ColorIndex
    Else
        cellule.Interior.ColorIndex = Params.Range("NomTrouvé")(1, 2).Interior.ColorIndex
    End If
Fin:
End Sub

Macro TriNoms

VB: 
Sub TriNoms()
    On Error GoTo SORTIE
    sh.Unprotect
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    With sh.Range(AdrTableau)
        .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlGuess, _
                           OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End If
 
SORTIE:
    sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
                      , AllowFormattingCells:=True
    Application.EnableEvents = True
    Application.EnableEvents = False
End Sub

Module This Workbook:
VB: 
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    If sh.Name <> Outils.Name And sh.Name <> Params.Name Then
        If Not Intersect(sh.Range(AdrCellCoul), Target) Is Nothing Then coloration Target
        If Not Intersect(sh.Range(AdrNoms), Target) Is Nothing Then Macros.TriNoms sh
    End If
End Sub

Par contre pour
pas d'intégration automatique des noms de tous les onglets dans l'onglet "Outils"
Cliquez pour agrandir...

Je n'ai rien trouvé qui le fasse dans ton classeur original?

A+

[Edit] je vois que Bernard avais corrigé l'erreur principale:)
Je crois qu'il est important de mettre un on error resume next dans la macro de tri pour éviter à application.enableEvents de rester = False si une erreur se produit dans la macro (aucune données à trier par exemple)
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
E

Emmanuel31

XLDnaute Occasionnel
Re : Planing : Récupération d'une liste des noms présents dans tous les onglets

Ou la la ... je suis en train de m'y perdre complet là ...

Entre les codes des uns et des autres, j'ai tout qui se croise et j'ai plus grand chose qui marche ...

Vous avez un fichier pour consolider tout cela svp ?
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Autres Récupération des noms + équipes dans une liste
Réponses
2
Affichages
124
DJunqueira
D
F
  • Résolu(e)
XL 2021 recherche doublons dans colonne puis suppression des lignes
Réponses
5
Affichages
165
ftpo69
F
Usine à gaz
  • Résolu(e)
XL 2021 Bloquer la sélection des autres onglets sous condition (sans les masquer)
Réponses
2
Affichages
221
Usine à gaz
Usine à gaz
B
  • Question
XL 2016 Formule Recherche d'une cellule dans plusieurs onglets différents
Réponses
2
Affichages
189
oguruma
oguruma
M
  • Question
Google Sheets Recopie des formules dans plusieurs onglets
Réponses
0
Affichages
243
Moreno076
M
S
  • Question
XL 2021 Planning de suivi des actions pour service Hygiène Sécurité et Environnement
Réponses
2
Affichages
233
fanfan38
fanfan38
Yuby
  • Résolu(e)
XL 2013 VBA : copier cellule d'un classeur vers une cellule d'un autre classeur
Réponses
13
Affichages
1 K
Yuby
Yuby
H
  • Question
Microsoft 365 formule qui fait apparaitre les nouveaux "noms" d'une liste à chaque rajout dans la base
Réponses
3
Affichages
283
JHA
J
A
  • Résolu(e)
Microsoft 365 Copier la même cellule de plusieurs onglets dans différentes colonnes
2
Réponses
23
Affichages
818
AlexiaC
A
C
  • Résolu(e)
Microsoft 365 Mise en forme d'une ligne d'après listes déroulantes + clic sur un bouton
Réponses
2
Affichages
329
casualexcel
C

Membres actuellement en ligne

25 membres et 418 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 152
Messages
2 085 787
Membres
102 973
dernier inscrit
docpod