problème de selection et de coloriage

D

dmoluc

XLDnaute Occasionnel
Bonsoir à tous,
J'ai avancé un peu plus mon diagramme de Gant et j'ai réussi à intégrer les jours fériés. J'ai pensé colorier les deux colonnes des jours fériés afin de pouvoir mettre une condition pour sauter ces jours là lors du remplissage du planning, mais voilà impossible de sélectionner les cellules à coloriées, pourtant les conditions ont bien l'air de fonctionner
Code: 
Range("DN1") = myDate
Dim colonne As Integer
Dim Colonne2 As Integer
Dim tmpDate As Date
Dim dtDate As Date
Dim Fin As Date
Fin = Me.DTPicker21.Value
While Fin < Range("DM5").Value
Range("F5").Select
 ActiveCell.Offset(0, 1).Select
 colonne = ActiveCell.Column
Colonne2 = (colonne + 1)
dtDate = ActiveCell.Value
Fin = (Fin + 1)
Ligne = 6
ActiveCell.Offset(1, 0).Select
 
Dim H As Integer, M As Integer, D As Integer
 
 'Les valeurs de H, de M, et de D sont bien trouver par le programme  
 
    H = Year(dtDate): M = Month(dtDate): D = Day(dtDate)
    If M = 1 And D = 1 Then
        fJourFerie = "1er Janvier - Jour de l'An"
 
Apparament c'est la que ça coince mais c'est compliquer de savoir car pas facile de faire tourner la routine jusqu'à un jour férié
       Range(ActiveCell, ActiveCell.End(xlDown)).Select
 
'là j'utilise du code généré automatiquement, ce doit être pas très beau
 
       With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
    ElseIf M = 5 And D = 1 Then
        fJourFerie = "1er Mai - Fête du Travail"
         Range(ActiveCell, ActiveCell.End(xlDown)).Select
       With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
       End With
 
    ElseIf M = 5 And D = 8 Then
        fJourFerie = "8 Mai - Victoire 1945"
         Range(ActiveCell, ActiveCell.End(xlDown)).Select
       With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
 
    ElseIf M = 7 And D = 14 Then
        fJourFerie = "14 Juillet - Fête nationale"
         Range(ActiveCell, ActiveCell.End(xlDown)).Select
       With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
 
    ElseIf M = 8 And D = 15 Then
        MsgBox "15 Août - Assomption"
         Range(ActiveCell, ActiveCell.End(xlDown)).Select
       With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
 
    ElseIf M = 11 And D = 1 Then
        fJourFerie = "1er Novembre - Toussaint"
         Range(ActiveCell, ActiveCell.End(xlDown)).Select
       With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
 
    ElseIf M = 11 And D = 11 Then
        fJourFerie = "11 Novembre - Armistice 1918"
         Range(ActiveCell, ActiveCell.End(xlDown)).Select
       With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
 
    ElseIf M = 12 And D = 25 Then
        fJourFerie = "25 Décembre - Noël"
        Range(ActiveCell, ActiveCell.End(xlDown)).Select
       With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
 
    Else
 
        tmpDate = fLundiPaques(H)
 
        If dtDate = tmpDate Then
            fJourFerie = "Lundi de Pâques"
            Range(ActiveCell, ActiveCell.End(xlDown)).Select
       With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
 
        ElseIf dtDate = tmpDate + 38 Then
            fJourFerie = "Ascension"
             Range(ActiveCell, ActiveCell.End(xlDown)).Select
       With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
 
        ElseIf dtDate = tmpDate + 49 Then
            fJourFerie = "Lundi de Pentecôte"
             Range(ActiveCell, ActiveCell.End(xlDown)).Select
       With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
     End With
 
        End If
    End If
    Wend
  Exit Sub
Comme le classeur devient de plus en plus compliquer je le joint épurer du superflu et il va manquer des valeur sur le tableau mais comme le fichier original dépasse les 3 MO il faut bien supprimer pour arriver à 293 KO
Merci pour votre aide
cordialement
Didier
 

Pièces jointes

  • essais.xlsm
    222.3 KB · Affichages: 48
  • essais.xlsm
    222.3 KB · Affichages: 58
  • essais.xlsm
    222.3 KB · Affichages: 53
Trier par date Trier par votes
D

dmoluc

XLDnaute Occasionnel
Re : problème de selection et de coloriage

J' ai réussi à réparer ma boucle mais je ne suis pas encore au bout de mes peines car maintenant c'est la selection de la colonne qui pose problème
#Range(ActiveCell, ActiveCell.End(xlDown)).Select#
ce code me sélectionne bien les cellules non vide mais s'arrête dés que la cellule est vide
Si quelqu'un à une idée ? En fait je voudrais sélectionner de la ligne 5 à la ligne 131 en sachant que le N° de colonne est dans la variable colonne
Merci pour votre aide
 
Vote positif 0 Vote négatif
B

Bebere

XLDnaute Barbatruc
Re : problème de selection et de coloriage

bonjour dmoluc
avec ce code
tu pouvais aussi faire une liste de jours fériés dans un feuille et comparer(ex:classeur datesetheurescmc.xls en téléchargement)
en général pas besoin de select dans un code
oublie les cellules fusionnées(difficile à gérer)
Code: 
Function TYPEJOUR(D As Date)
'L. Longre
'Cette fonction renvoie 0 si le jour passé en paramètre est un jour de semaine,
'1 s'il s'agit d'un samedi ou d'un dimanche et 2 s'il s'agit d'un jour férié.
'Valide jusqu'en 2099 et pour les jours fériés français

    Dim A As Integer, T As Integer
    Dim LP As Date, LD As Long
    Dim Toto As Long

    A = Year(D)
    If A > 2099 Then
        TYPEJOUR = CVErr(xlErrValue)
        Exit Function
    End If
    LD = Int(D)
    If LD <= 2 Then
        If LD = 1 Then TYPEJOUR = 2
        Exit Function
    End If
    T = (((255 - 11 * (A Mod 19)) - 21) Mod 30) + 21
    LP = DateSerial(A, 3, 2) + T + (T > 48) _
       + 6 - ((A + A \ 4 + T + (T > 48) + 1) Mod 7)
    Select Case D
        ' Jours fériés mobiles
    Case Is = LP, Is = LP + 38, Is = LP + 49
        TYPEJOUR = 2
        ' Jours fériés fixes
    Case Is = DateSerial(A, 1, 1), Is = DateSerial(A, 5, 1), _
         Is = DateSerial(A, 5, 8), Is = DateSerial(A, 7, 14), _
         Is = DateSerial(A, 8, 15), Is = DateSerial(A, 11, 1), _
         Is = DateSerial(A, 11, 11), Is = DateSerial(A, 12, 25)
        TYPEJOUR = 2
    Case Else
        ' Samedi ou dimanche
        If Weekday(D, vbMonday) >= 6 Then TYPEJOUR = 1
    End Select

End Function


Sub X()'la feuille doit être active
Dim cel As Range, X As Date, DerL As Long, Col As Byte
DerL = Cells(65536, "G").End(xlUp).Row

For Each cel In Range("G5", Cells(5, Cells(5, 256).End(xlToLeft).Column))
X = cel: Col = cel.Column
If TYPEJOUR(X) = 1 Or TYPEJOUR(X) = 2 Then
Range(Cells(5, Col), Cells(DerL, Col)).Interior.ColorIndex = 22
End If
Next cel

End Sub
 
Vote positif 0 Vote négatif
D

dmoluc

XLDnaute Occasionnel
Re : problème de selection et de coloriage

merci pour ton aide mais j'utilise déjà une fonction similaire sans doute moins pratique que celle-ci alors je la garde sous le coude si jamais je n'arrive pas à exploitée la mienne
je suis quand même arrivé à colorier les colones des jours fériés, alors je dois être pré du but
cordialement
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
XL 2019 appliquer une macro sur n'importe quel fichier excel
2
Réponses
22
Affichages
3 K
pasquetp
P
ZAKAO
  • Résolu(e)
XL 2013 Ecriture de code condensé
Réponses
9
Affichages
543
ZAKAO
ZAKAO
dindin
  • Question
XL 2016 simplifier une macro enregistrée
Réponses
8
Affichages
683
dindin
dindin
D
  • Question
XL pour MAC [RESOLU]Cacher ou afficher colonnes, sauf colonne selectionné
Réponses
9
Affichages
862
Dudy
D
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
348
Francky79
F
H
  • Question
XL 2016 Mettre des titres avec une mise en forme spécifique
Réponses
1
Affichages
385
vgendron
vgendron
AlCapone
  • Résolu(e)
Microsoft 365 VBA - BeforeDoubleClick, 1ère cellule vide à partir de cellule active pour insertion de ligne
Réponses
4
Affichages
108
AlCapone
AlCapone
S
  • Résolu(e)
XL 2019 VBA pour créer un nouvel onglet
Réponses
2
Affichages
621
sum01
S
S
  • Résolu(e)
XL 2019 Problème de remplissage cellule en vba
Réponses
5
Affichages
299
snoopy07
S
PORCHER
  • Question
Microsoft 365 Incompatibilité de type
Réponses
1
Affichages
227
Dranreb
Dranreb

Membres actuellement en ligne

17 membres et 314 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
314 422
Messages
2 109 447
Membres
110 482
dernier inscrit
ilyxxxh