Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 Vba modifier les cellules sous mfc

Pinierdavid

XLDnaute Nouveau
Bonsoir

je suis nouveau sur le forum je recherche une solution pour agir en vba sur des cellules sous mfc ( avec formule si par rapport à une autre cellule ).
C’est un planning de prod avec des dates si c’est un jour fériés toutes les cases correspondant à ce jour pour chaque employer se mettent en noir et j’aimerais mettre l’a valeurs des case à zéro
J’ai chercher mais je n’est pas trouver de solution sur les différents forums
Si quelqu’un peut m’aider je suis preneur
 

Pinierdavid

XLDnaute Nouveau
Le nom des feuilles c
‘Janvier’
´fevrier’
Ect ...
La dernière feuille s’appelle janvier n+1
De toute façon cela sera une macro utilisée 1 seul fois par an
A part celle pour les congés que je mettrais dans le planning de présence sur chaque mois je pense
 

Dudu2

XLDnaute Barbatruc
Mets ce code dans un module.
Valorise la constante MotDePasse à sa valeur correcte.
Exécuter la fonction Effacer() qui appelle EffacerRouge() et EffacerNoire().
VB:
Option Explicit

Private Const MotDePasse = "aaaa"
Private Const ListeMois = "JANVIER,FEVRIER,MARS,AVRIL,MAI,JUIN,JUILLET,AOUT,SEPTEMBRE,OCTOBRE,NOVEMBRE,DECEMBRE,JANVIER N+1"

Sub Effacer()
    If MsgBox("Etes-vous sûr de vouloir effacer toutes les données saisies ?", vbYesNo) = vbYes Then
        Call EffacerRouge
        Call EffacerNoire
        MsgBox "Terminé."
    Else
        MsgBox "Abandon."
    End If
End Sub

Sub EffacerRouge()
    Dim Cell As Range
    Dim NomFeuille As Variant
    Dim Feuille As Worksheet
    Dim T() As Variant
    Dim d As Variant
    Dim d1 As Variant
    Dim d2 As Variant
    Dim i As Integer
    Dim j As Integer
    Dim ErrNumber As Variant
    Dim AppliesToRange As Range
    Dim Protection As Boolean
    Dim TabMois() As String
    Const PremièreCellule = "$R$6"
    Const Formule = "=SI(R$1:$CI$1>$D$203;1;SI(R$1:$CI$1<$D$202;1;0))"
    
    TabMois = Split(ListeMois, ",")
  
    For Each NomFeuille In TabMois
        On Error Resume Next
        Err.Clear
        Set Feuille = ThisWorkbook.Worksheets(NomFeuille)
        ErrNumber = Err.Number
        On Error GoTo 0
        
        'Feuille non trouvée
        If ErrNumber Then
            MsgBox "La feuille """ & NomFeuille & """ n'existe pas !" & vbCrLf & vbCrLf & _
                   "Le traitement continue sur les autres feuilles."
        
        'Feuille trouvée
        Else
            'Feuille protégée
            If Feuille.ProtectContents Then
                Protection = True
                On Error Resume Next
                Feuille.Unprotect Password:=MotDePasse
                ErrNumber = Err.Number
                On Error GoTo 0
            Else
                Protection = False
            End If
            
            'Protection non supprimée
            If ErrNumber Then
                MsgBox "La feuille """ & NomFeuille & """ n'a pas pu être déprotégée !" & vbCrLf & _
                       "Déprotéger la feuille ou vérifier le mot de passe dans le code." & vbCrLf & vbCrLf & _
                       "Le traitement continue sur les autres feuilles."
            
            'Pas de protection ou protection supprimée
            Else
                'Recherche de la MFC concernée
                Set Cell = Feuille.Range(PremièreCellule)
                For i = 1 To Cell.FormatConditions.Count
                    With Cell.FormatConditions(i)
                        If .Type = xlExpression And .Formula1 = Formule Then
                            Set AppliesToRange = .AppliesTo
                            Exit For
                        End If
                    End With
                Next i
                
                'MFC non trouvée
                If i > Cell.FormatConditions.Count Then
                    MsgBox "Sur la feuille """ & NomFeuille & """, la MFC n'a pas été trouvée telle qu'attendue en " & PremièreCellule & _
                           " pour la formule:" & vbCrLf & _
                           "Formule: " & Formule & vbCrLf & vbCrLf & _
                           "Le traitement continue sur les autres feuilles."
                
                'MFC trouvée
                Else
                    'Table aux valeurs de l'AppliesTo Range de la MFC
                    T = AppliesToRange.Value
                    
                    'Dates à comparer
                    d1 = Feuille.Range("$D$203").Value
                    d2 = Feuille.Range("$D$202").Value
                    
                    For i = 1 To UBound(T, 1)
                        For j = 1 To UBound(T, 2)
                            If T(i, j) = 1 Then
                                d = Feuille.Cells(1, j + 17).Value
                                If d > d1 Or d < d2 Then
                                    'MsgBox Cell.Address
                                    T(i, j) = ""
                                End If
                            End If
                        Next j
                    Next i
                    
                    'Valeurs de l'AppliesTo Range de la MFC aux valeurs de la table
                    AppliesToRange.Value = T
                    
                    'Reset de la protection
                    If Protection Then Feuille.Protect Password:=MotDePasse
                End If
            End If
        End If
    Next NomFeuille
End Sub


Sub EffacerNoire()
    Dim Cell As Range
    Dim NomFeuille As Variant
    Dim Feuille As Worksheet
    Dim T() As Variant
    Dim d As Variant
    Dim Td() As Variant
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim ErrNumber As Variant
    Dim AppliesToRange As Range
    Dim Protection As Boolean
    Dim TabMois() As String
    Const PremièreCellule = "$R$6"
    Const Formule = "=SI(R$1:$CI$1=CALENDRIER!$V$3;1;SI(R$1:$CI$1=CALENDRIER!$V$4;1;SI(R$1:$CI$1=CALENDRIER!$V$5;1;SI(R$1:$CI$1=CALENDRIER!$V$6;1;SI(R$1:$CI$1=CALENDRIER!$V$7;1;SI(R$1:$CI$1=CALENDRIER!$V$8;1;SI(R$1:$CI$1=CALENDRIER!$V$9;1;SI(R$1:$CI$1=CALENDRIER!$V$10;1;SI(R$1:$CI$1=CALENDRIER!$V$11;1;SI(R$1:$CI$1=CALENDRIER!$V$12;1;SI(R$1:$CI$1=CALENDRIER!$V$13;1;SI(R$1:$CI$1=CALENDRIER!$V$14;1;SI(R$1:$CI$1=CALENDRIER!$V$15;1;SI(R$1:$CI$1=CALENDRIER!$V$16;1;0))))))))))))))"
    
    TabMois = Split(ListeMois, ",")
    
    For Each NomFeuille In TabMois
        On Error Resume Next
        Err.Clear
        Set Feuille = ThisWorkbook.Worksheets(NomFeuille)
        ErrNumber = Err.Number
        On Error GoTo 0
        
        'Feuille non trouvée
        If ErrNumber Then
            MsgBox "La feuille """ & NomFeuille & """ n'existe pas !" & vbCrLf & vbCrLf & _
                   "Le traitement continue sur les autres feuilles."
        
        'Feuille trouvée
        Else
            'Feuille protégée
            If Feuille.ProtectContents Then
                Protection = True
                On Error Resume Next
                Feuille.Unprotect Password:=MotDePasse
                ErrNumber = Err.Number
                On Error GoTo 0
            Else
                Protection = False
            End If
            
            'Protection non supprimée
            If ErrNumber Then
                MsgBox "La feuille """ & NomFeuille & """ n'a pas pu être déprotégée !" & vbCrLf & _
                       "Déprotéger la feuille ou vérifier le mot de passe dans le code." & vbCrLf & vbCrLf & _
                       "Le traitement continue sur les autres feuilles."
            
            'Pas de protection ou protection supprimée
            Else
                'Recherche de la MFC concernée
                Set Cell = Feuille.Range(PremièreCellule)
                For i = 1 To Cell.FormatConditions.Count
                    With Cell.FormatConditions(i)
                        If .Type = xlExpression And .Formula1 = Formule Then
                            Set AppliesToRange = .AppliesTo
                            Exit For
                        End If
                    End With
                Next i
                
                'MFC non trouvée
                If i > Cell.FormatConditions.Count Then
                   MsgBox "Sur la feuille """ & NomFeuille & """, la MFC n'a pas été trouvée telle qu'attendue en " & PremièreCellule & _
                          " pour la formule:" & vbCrLf & _
                           "Formule: " & Formule & vbCrLf & vbCrLf & _
                           "Le traitement continue sur les autres feuilles."
                
                'MFC trouvée
                Else
                    'Table aux valeurs de l'AppliesTo Range de la MFC
                    T = AppliesToRange.Value
                    
                    'Dernière ligne colonne V de la feuille CALENDRIER
                    i = ThisWorkbook.Worksheets("CALENDRIER").Range("V" & Rows.Count).End(xlUp).Row
                    'Dates à comparer
                    Td = ThisWorkbook.Worksheets("CALENDRIER").Range("V3:V" & i).Value
                    
                    For i = 1 To UBound(T, 1)
                        For j = 1 To UBound(T, 2)
                            If T(i, j) = 1 Then
                                d = Feuille.Cells(1, j + 17).Value
                                For k = 1 To UBound(Td, 1)
                                    If d = Td(k, 1) Then Exit For
                                Next k
                                If k <= UBound(Td, 1) Then
                                    'MsgBox Cell.Address
                                    T(i, j) = ""
                                End If
                            End If
                        Next j
                    Next i
                    
                    'Valeurs de l'AppliesTo Range de la MFC aux valeurs de la table
                    AppliesToRange.Value = T
                    
                    'Reset de la protection
                    If Protection Then Feuille.Protect Password:=MotDePasse
                End If
            End If
        End If
    Next NomFeuille
End Sub
 
Dernière édition:

Pinierdavid

XLDnaute Nouveau
Je viens de lire ton code je suis vraiment impressionné et je me rend compte que j’étais très loin d’y arriver
Du coup tu pense que c possible dans le même esprit de faire pour les congés
Je m’explique de la feuille planning personnel cet fois à l’inverse si il ny a aucune valeur dans les cases la personne est présente et si je met 1 dans une cellule cela le met absent et jais fait une mfc dans les feuilles de janvier à janviers+1 pour récupérer l’information
Du coup si une personne est absente le lundi sur le filtre du mois de janvier par exemple ( sur le plannning personnel cela représente 1 cellule ) sur la feuille ‘janvier’ il y aura les 3 cases du lundi seront en rouge grâce la mfc
Mais la même problème mes cases sont toujours à 1 et je veut qu’elles soit à zéro
Je t’en demande beaucoup mais sa a l’air tellement simple pour toi et moi je n’y arrive pas et cela dépasse mes compétences
 

Dudu2

XLDnaute Barbatruc
Je ne comprends toujours pas. Essaie de répondre à ces questions 1 par 1:
1 - Dans quelle(s) feuille(s) faut-il modifier les cellules ?
2 - Quel est le Range des cellules à modifier dans cette ou ces feuilles ?
3 - Que faut-il modifier dans les cellules ? Les mettre à 1? 0 ? Vide ? Autre ?
4 - Quelle condition je dois exploiter pour modifier ces cellules ?
 

Pinierdavid

XLDnaute Nouveau
alors
1 et 2 dans les feuilles de janvier a janvier n+1 comme pour la macro précédente
3 idem de la macro précédente effacer le contenu
4 la condition est :
pour le mois de janvier :
='PLANNING PERSONNEL'!AL8:$DC$90=1
pour le mois de février :
='PLANNING PERSONNEL'!AL97:$DC$179=1
pour le mois de mars :
='PLANNING PERSONNEL'!AL186:$DC$268=1
ect ...
 

Pinierdavid

XLDnaute Nouveau
je viens d essayer ta macro elle fonctionne à merveille je suis bluffer un grand merci sans toi cela aurait été impossible
j'ai juste remarquer que cela ne me remet pas les même conditions sur la protection de la feuille c une ligne de code à rajouter ou c'est normal ?
 

Pinierdavid

XLDnaute Nouveau
Sub Macro200()
ActiveSheet.Unprotect Password:=MotDePasse
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True
End Sub
du coup je l'ai rajouter sur la macro et cela fonctionne
 

Pinierdavid

XLDnaute Nouveau
salut dudu2

Sur la macro sub effacer (noir et rouge), Jai détecter un problème les formules de recherche V s'efface sur les feuilles des mois (de janvier à janvier N+1) ce sont les dates qui doivent se mettre a jours avec le calendrier.(au dessus de matin et après midi)
Après j'ai essayer de rajouter sur la macro une formule pour remettre les conditions de protection de la feuille mais cela ne fonctionne pas donc je l'ai fait par enregistrement de macro mais je n'arrive pas à remettre le code quand je met les conditions le code vba ne me l'accepte pas
La macro pour la protection des feuilles fonctionne mais après je peu enlever sur chaque la protection sans mot de passe donc aucun interêt.
Dit moi si tu compte regarder, sinon je le ferais en manuel car les macros que tu m'a réaliser sont trop complexe pour moi
Quand meme un grand merci pour le temps que tu as passer
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…