XL 2016 changer le remplissage si pas de remplissage vba

[Sirberthoult]

Bonjour le forum,

j'ai ecris un code qui doit s'appliquer apres 12h, qui ne fonctionne pas mais je ne comprend pas pourquoi...

pouvez vous m'aider ?

Private Sub Workbook_Open()

Dim plage As Range
Dim cellule As Range
Dim plage2 As Range
Dim cellule2 As Range

If Hour(Now) > 12 Then

Set plage = Range("Q15:S16")

    For Each cellule In plage
        If cellule.Interior.Pattern = xlSolid Then
            With cellule.Interior
                .Pattern = xlGray8
            End With
        End If
   Next cellule

Set plage2 = Range("AF15:AH16")

    For Each cellule2 In plage
        If cellule2.Interior.Pattern = xlGray8 Then
            With cellule2.Interior
                .Pattern = xlSolid
            End With
        End If
    Next cellule2


End if
End sub

Merci

 

[Nain porte quoi]

Hello,

je vois un problème sur cette ligne
For Each cellule2 In plage
il me semble que ça devrait être plage2

 

[fanch55]

Bonjour, qu'est-ce qui ne fonctionne pas ?
Ce qui est entre le If et le Endif ne se déclenche pas ?
Ou c'est le for each qui ne change pas les patterns ?

 

[Sirberthoult]

Bonsoir,

effectivement erreur sur plage 2...

ceci dit, ca ne fonctionne pas mieux...j'ai mis mon fichier en piéce jointe
ce doit etre le for each qui ne change pas les patterns...

je souhaite que toutes les cellules qui n'ont pas de hachures dans les colonnes Q, R et S (celle-ci peuvent varie) reste ainsi avant midi et que celles en AF, AG et AH prenne des pointillés...
inversement apres 12h, ceci pour mettre en evidence les cellules à remplir et éviter de remplir les mauvaises cellules.

merci de votre aide

 

[Sirberthoult]

Bonsoir le forum,

apres plusieurs tests, je constate que le code ne reconnait pas le patterns des cellules sans motif. ( xlsolid, xlnone)
je fais changer le motif des cellules testées par une mfc , est ce a cause de ca que le code ne reconnait pas le motif ?

edit: je crois comprendre que mon code s'effectue à l'ouverture du fichier et que la mfc s'effectue ensuite et c'est donc pour ca que mon code ne s'applique pas...

comment résoudre ceci svp

merci de votre aide

 

[fanch55]

Bonsoir le forum,

apres plusieurs tests, je constate que le code ne reconnait pas le patterns des cellules sans motif. ( xlsolid, xlnone)
je fais changer le motif des cellules testées par une mfc , est ce a cause de ca que le code ne reconnait pas le motif ?

merci de votre aide

Effectivement, si les MFC altère les patterns, c'est le selection.displayformat.interior.pattern qu'il faut considérer .
Un mix des patterns ( normal et Mfc ) n'est pas vraiment conseillé dans votre cas,
modifier un pattern normal ==> Selection.interior.pattern = xlsolid
modifier un pattern de Mfc ==> Selection.FormatConditions(1).Interior.Pattern = xlsolid

 

[fanch55]

Testez le code ci-dessous

Private Sub Workbook_Open()
Dim cellule As Range

' Application.OnTime TimeValue("12:50:00"), "Ferme"
    Worksheets("Feuil1").Activate
    ActiveSheet.Unprotect Password:="toto"
    'Cells.FormatConditions.Delete

    If Day([M1]) < Day(Now) Or [M1] = "" Then 'la date inscrite est différente d'aujourd'hui alors
        [M1].Value = Now 'indique maintenant en M1
        [AB1].Value = "" ' on efface l'aprem de la veille en AB1
    Else
        [AB1].Value = Now 'indique maintenant
    End If

    CurrentPattern = IIf(Hour(Now) <= 12, xlSolid, xlGray8)
    OtherPattern = IIf(CurrentPattern = xlSolid, xlGray8, xlSolid)
       
    Range("M10:P13,M15:P16,M18:P22,M24:P27,M29:P32,M34:P37,M39:P42,P44:P48") _
        .Interior.Pattern = CurrentPattern
    Range("T10:U13,T15:U16,T18:U22,T24:U27,T29:U32,T34:U37,T39:U42") _
        .Interior.Pattern = CurrentPattern
    For Each cellule In Range("Q15:S16")
        ' Vérifie si la cellule n'a pas de couleur de fond (xlNone ou index -4142)
        If cellule.Interior.Pattern = OtherPattern _
        Then cellule.Interior.Pattern = CurrentPattern
    Next
   
' alternate
    Range("AB10:AE13,AB15:AE16,AB18:AE22,AB24:AE27,AB29:AE32,AB34:AE37,AB39:AE42,AE44:AE48") _
        .Interior.Pattern = OtherPattern
    Range("AI10:AJ13,AI15:AJ16,AI18:AJ22,AI24:AJ27,AI29:AJ32,AI34:AJ37,AI39:AJ42") _
        .Interior.Pattern = OtherPattern
    For Each cellule In Range("AF15:AH16")
        ' Vérifie si la cellule n'a pas de couleur de fond (xlNone ou index -4142)
        If cellule.Interior.Pattern = CurrentPattern _
        Then cellule.interior.Pattern = OtherPattern
    Next

   
    ActiveSheet.Protect Password:="toto", DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

 

[Sirberthoult]

Testez le code ci-dessous

Private Sub Workbook_Open()
Dim cellule As Range

' Application.OnTime TimeValue("12:50:00"), "Ferme"
    Worksheets("Feuil1").Activate
    ActiveSheet.Unprotect Password:="toto"
    'Cells.FormatConditions.Delete

    If Day([M1]) < Day(Now) Or [M1] = "" Then 'la date inscrite est différente d'aujourd'hui alors
        [M1].Value = Now 'indique maintenant en M1
        [AB1].Value = "" ' on efface l'aprem de la veille en AB1
    Else
        [AB1].Value = Now 'indique maintenant
    End If

    CurrentPattern = IIf(Hour(Now) <= 12, xlSolid, xlGray8)
    OtherPattern = IIf(CurrentPattern = xlSolid, xlGray8, xlSolid)
      
    Range("M10:P13,M15:P16,M18:P22,M24:P27,M29:P32,M34:P37,M39:P42,P44:P48") _
        .Interior.Pattern = CurrentPattern
    Range("T10:U13,T15:U16,T18:U22,T24:U27,T29:U32,T34:U37,T39:U42") _
        .Interior.Pattern = CurrentPattern
    For Each cellule In Range("Q15:S16")
        ' Vérifie si la cellule n'a pas de couleur de fond (xlNone ou index -4142)
        If cellule.Interior.Pattern = OtherPattern _
        Then cellule.Interior.Pattern = CurrentPattern
    Next
  
' alternate
    Range("AB10:AE13,AB15:AE16,AB18:AE22,AB24:AE27,AB29:AE32,AB34:AE37,AB39:AE42,AE44:AE48") _
        .Interior.Pattern = OtherPattern
    Range("AI10:AJ13,AI15:AJ16,AI18:AJ22,AI24:AJ27,AI29:AJ32,AI34:AJ37,AI39:AJ42") _
        .Interior.Pattern = OtherPattern
    For Each cellule In Range("AF15:AH16")
        ' Vérifie si la cellule n'a pas de couleur de fond (xlNone ou index -4142)
        If cellule.Interior.Pattern = CurrentPattern _
        Then cellule.interior.Pattern = OtherPattern
    Next

  
    ActiveSheet.Protect Password:="toto", DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

Bonjour le forum,fanch55,

merci beaucoup !! c'est parfait !