XL 2016 changer le remplissage si pas de remplissage vba

Sirberthoult · 2 Juillet 2025

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 ?

VB:

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

fanch55 · 3 Juillet 2025

Testez le code ci-dessous

VB:

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") _...

Nain porte quoi · 2 Juillet 2025

Hello,

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

fanch55 · 2 Juillet 2025

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 · 2 Juillet 2025

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 · 2 Juillet 2025

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 · 2 Juillet 2025

Sirberthoult à dit:
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 · 3 Juillet 2025

Testez le code ci-dessous

VB:

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 · 4 Juillet 2025

fanch55 à dit:

Testez le code ci-dessous

VB:

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 !

XL 2016 changer le remplissage si pas de remplissage vba

Sirberthoult

XLDnaute Occasionnel

fanch55

Nain porte quoi

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

Sirberthoult

XLDnaute Occasionnel

Pièces jointes

Sirberthoult

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

Sirberthoult

XLDnaute Occasionnel

Discussions similaires

XL 2016 changer le remplissage si pas de remplissage vba

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency