XL 2010 Vba modifier les cellules sous mfc

Pinierdavid · 27 Mars 2020

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 · 29 Mars 2020

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 · 29 Mars 2020

Les feuilles sont protégées avec un mot de passe non vide.
Pas possible de modifier les feuilles.
C'est quoi le mot de passe ?

Dudu2 · 29 Mars 2020

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

Pinierdavid · 29 Mars 2020

MDP : comeca

Pinierdavid · 29 Mars 2020

J’essaye ce soir le code
Vraiment merci pour ton travail

Pinierdavid · 29 Mars 2020

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 · 29 Mars 2020

Mais la même problème mes cases sont toujours à 1 et je veut qu’elles soit à zéro

Tu parles de quelles cases ? Dans quelle(s) feuille(s) ? PLANNING PERSONNEL ? Les feuilles des mois ?
De quelle MFC s'agit-il ?

Pinierdavid · 29 Mars 2020

Dans la feuille planning personnel
Il y a des cellules quand tu regarde le haut du tableau il y a marquer L M M J V qui sont les jours de la semaine
Sur les feuilles mensuel c’est la 3 eme mfc

Dudu2 · 29 Mars 2020

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 · 29 Mars 2020

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 · 29 Mars 2020

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 · 29 Mars 2020

j'ai réussi a mettre les lignes pour remettre les mêmes conditions de protection sur les feuilles

Pinierdavid · 29 Mars 2020

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 · 31 Mars 2020

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

Effectuez une recherche sur Excel Downloads...

XL 2010 Vba modifier les cellules sous mfc

Pinierdavid

XLDnaute Nouveau

Pinierdavid

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Pinierdavid

XLDnaute Nouveau

Pinierdavid

XLDnaute Nouveau

Pinierdavid

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

Pinierdavid

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

Pinierdavid

XLDnaute Nouveau

Pinierdavid

XLDnaute Nouveau

Pinierdavid

XLDnaute Nouveau

Pinierdavid

XLDnaute Nouveau

Pinierdavid

XLDnaute Nouveau

Discussions similaires

Nous accordons de l'importance à votre vie privée