XL 2013 MFC week end

minimutch

XLDnaute Junior
Bonjour,

Je n'arrive pas à mettre les week end en gris par une MFC.
Sachant qu'un jour comporte 2 colonnes (matin / am).

Merci
 

Pièces jointes

  • Planning.xlsx
    41.4 KB · Affichages: 63
  • Planning.xlsx
    41.4 KB · Affichages: 60

Efgé

XLDnaute Barbatruc
Re : MFC week end

Bonjour minimutch, Job :), le fil, le forum

Bon, j'en suis là :
Sans macros, à base mises en formes conditionnelles.
Choix de l'année en $A$1 et choix du premier mois affiché en $A$2.
Affichage sur trois mois glissants.
Prise en compte des fériés et W.E.
Depuis 1904 jusqu’à 9999.

Après je pense avoir été au bout de la demande initiale.

Cordialement

 

Pièces jointes

  • week-end-planning(10).xlsx
    50.5 KB · Affichages: 28

Efgé

XLDnaute Barbatruc
Re : MFC week end

Re

Pour clore le sujet:
Une version complète, avec la prise en compte des évenements.

Il faut saisir les congés en feuille "Congés"
Les noms doivent être strictement identiques à la liste présente sur la feuille "Planning"
Les codes "Types" doivent être respectés également (la liste des codes est sur la feuille).
Les matins (AM) et après-midi (PM) sont pris en compte. L'absence de donnée dans la colonne AM/PM vaux pour journée entière.

Le grand nombre de cellules impactées par les mise en forme font bien ralentir le fichier (sous 2007/Vista, c'est assez lourd).

Bon courage pour la suite

Cordialement
 

Pièces jointes

  • week-end-planning(11).xlsx
    53.5 KB · Affichages: 26

job75

XLDnaute Barbatruc
Re : MFC week end

Bonsoir minimutch, Efgé,

Pour clore le sujet:

Ben non, je n'avais pas vu que vous vouliez un planning glissant sur 3 mois.

J'ai adapté (non sans mal) la macro précédente, c'est bien sûr plus rapide :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim an As Range, mois As Range, i&, j%, r As Range
Set an = [A1]: Set mois = [A2]
If Intersect(Target, Union(an, mois)) Is Nothing Then Exit Sub
If Val(CStr(an)) < 2010 Or Val(CStr(mois)) < 1 Or Val(CStr(mois)) > 12 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'pour la fusion des cellules
With [B3:GE58] '58 à adapter au nombre de noms
  '---entrée des mois---
  .Cells(-1, 1) = UCase(Format(DateSerial(an, mois, 1), "mmmm"))
  .Cells(-1, 63) = UCase(Format(DateSerial(an, mois + 1, 1), "mmmm"))
  .Cells(-1, 125) = UCase(Format(DateSerial(an, mois + 2, 1), "mmmm"))
  '---semaines et bordures fines---
  .Rows(1).UnMerge 'défusionne
  .Rows(1) = "=""SEM ""&ISOWEEKNUM(R[2]C)"
  .Rows(1) = .Rows(1).Value
  For i = 2 To .Columns.Count Step 2
    .Columns(i).Borders(xlEdgeRight).Weight = xlHairline 'RAZ
    If .Cells(1, i) <> .Cells(1, i + 1) Then
      j = Application.Match(.Cells(1, i), .Rows(1), 0)
      Set r = .Cells(1, j).Resize(, i - j + 1)
      r.Merge 'fusionne
      r.HorizontalAlignment = xlCenter
      Intersect(r.EntireColumn, .Cells).Borders(xlEdgeRight).Weight = xlThin
    End If
  Next
  '---bordures épaisses des mois, affichage/masquage des 29 30 31---
  .ColumnWidth = 1 'affiche tout
  For i = 1 To .Columns.Count Step 62
    Set r = .Cells(-1, i)
    Intersect(r.MergeArea.EntireColumn, .Cells).Borders(xlEdgeRight).Weight = xlThick
    If IsNumeric(Application.Match(Month(r(5)), Array(2, 4, 6, 9, 11), 0)) Then
      r(1, 61).Resize(, 2).ColumnWidth = 0.08
      If Month(r(5)) = 2 Then
        r(1, 57).Resize(, 4).ColumnWidth = 0
        If Month(r(5, 57)) = 2 Then r(1, 57).Resize(, 2).ColumnWidth = 1
      End If
    End If
  Next
End With
End Sub
Fichier joint, notez les formules avec DATE en ligne 5 pour le 1er jour de chaque mois.

La macro s'exécute chez moi (Win 10 - Excel 213) en 0,12 seconde.

Il n'y a aucune lourdeur puisque les 2 MFC (WE et jours fériés) sont très simples.

Edit : pour masquer les colonnes, j'ai mis les largeurs 0 (29 et 30 février) et 0.08 (31 du mois).

Chez moi les bordures épaisses restent bien visibles, chez vous aussi ?

A+
 

Pièces jointes

  • Planning glissant VBA ISO(1).xlsm
    71.1 KB · Affichages: 28
Dernière édition:

job75

XLDnaute Barbatruc
Re : MFC week end

Bonjour minimutch, Efgé, le forum,

Le sujet n'était toujours pas clos :cool:

Voici maintenant un code qui applique les couleurs (de fond) des congés :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'-----
Worksheet_Activate 'pour mise à jour des couleurs
End Sub

Private Sub Worksheet_Activate()
Dim cc%, dat, conges, ub&, t, d As Object, i&, x$, y$, test1, test2
Dim lig&, col%, CP As Range, AM As Range, CE As Range, CH As Range
Dim c As Range, a
Application.ScreenUpdating = False
With [B6:GE58] '58 à adapter au nombre de noms
  cc = .Columns.Count
  dat = .Rows(0).Value
  conges = Feuil2.[A1].CurrentRegion.Resize(, 5) 'CodeName de la feuille
  ub = UBound(conges)
  .Interior.ColorIndex = xlNone 'RAZ des couleurs
  '---liste des noms (sans doublon)pour accélérer---
  t = .Columns(0).Resize(, 2) 'au moins 2 éléments
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(t)
    If t(i, 1) <> "" Then d(t(i, 1)) = i 'repérage de la ligne
  Next
  If d.Count = 0 Then Exit Sub 'si aucun nom
  '---création des zones de couleur à partir du tableau des congés---
  For i = 2 To UBound(conges)
    If d.exists(conges(i, 1)) Then
      x = conges(i, 4): y = conges(i, 5)
      test1 = y = "AM" Or y = "": test2 = y = "PM" Or y = ""
      lig = d(conges(i, 1)) 'utilise le repérage
      For col = 1 To cc Step 2
        If dat(1, col) >= conges(i, 2) And dat(1, col) <= conges(i, 3) Then
          Set c = .Cells(lig, col)
          Select Case x
            Case "CP": Zone x, CP, c, test1, test2
            Case "AM": Zone x, AM, c, test1, test2
            Case "CE": Zone x, CE, c, test1, test2
            Case "CH": Zone x, CH, c, test1, test2
          End Select
        End If
        If dat(1, col) > conges(i, 3) Then Exit For
      Next col
    End If
  Next i
  '---restitution de ce qu'il reste à restituer---
  a = Array("CP", "AM", "CE", "CH")
  For i = 0 To UBound(a)
    x = a(i)
    Select Case x
      Case "CP": Restitution x, CP
      Case "AM": Restitution x, AM
      Case "CE": Restitution x, CE
      Case "CH": Restitution x, CH
    End Select
  Next
End With
End Sub

Sub Zone(x$, r As Range, c As Range, test1, test2)
If test1 Then Set r = Union(IIf(r Is Nothing, c, r), c)
If test2 Then Set r = Union(IIf(r Is Nothing, c(1, 2), r), c(1, 2))
'---restitution partielle pour alléger si trop de zones disjointes---
If r.Areas.Count > 100 Then Restitution x, r
End Sub

Sub Restitution(x$, r As Range)
Dim c As Range
Set c = [Couleurs].Cells(Application.Match(x, [Couleurs].Columns(2), 0), 1)
If Not r Is Nothing Then r.Interior.Color = c.Interior.Color: Set r = Nothing
End Sub
Il s'exécute quand on active la feuille "Planning"

Il est très rapide même sur de grands tableaux.

Fichier joint.

A+
 

Pièces jointes

  • Planning glissant VBA ISO(2).xlsm
    79.7 KB · Affichages: 36
Dernière édition:

minimutch

XLDnaute Junior
Re : MFC week end

Merci beaucoup à vous tous.
Toutefois, je garde le 1er tableau type de Efgé qui me correspond le plus.
Mon soucis est juste pour le changement d'année pour que les jours fériés se mettent comme pour les autres mois. Mais ma MFC ne se fait pas correctement. Si vous pouviez juste me donner un dernier coup de main sur ce point et ça sera très très bien.

Bizzz
 

job75

XLDnaute Barbatruc
Re : MFC week end

Bonjour minimutch, le forum,

Bien sûr vous faites ce que vous voulez, mais mon fichier ne pose aucun problème quand on change d'année :cool:

Edit : a priori le fichier d'Efgé non plus d'ailleurs, vous avez dû mal adapter.

Bonne journée.
 
Dernière édition:

minimutch

XLDnaute Junior
Re : MFC week end

Ah je ne dis pas du tout que votre fichier n'est pas bien au contraire. Je trouve ça très bien fait.
Moi je veux juste la formule qui me permet d'indiquer les jours fériés pour Janvier 2017.
Car quand je mets 2017, j'ai les week end mais les fériés quis e mettent.

merci bcp en tous els cas je garde votre fichier sous le coude.
 

job75

XLDnaute Barbatruc
Re : MFC week end

Re,

J'ai dupliqué les 2 tableaux sur 1000 lignes avec des noms tous différents et avec les dates de congés d'origine.

La macro Worksheet_Activate s'exécute en 0,9 seconde.

Avec 10000 lignes => 9 secondes.

Si l'on change le mois ou l'année c'est juste un petit peu plus long.
 

Efgé

XLDnaute Barbatruc
Re : MFC week end

Bonjour minimutch, Salut Job :)

@minimutch :
Ton dernier exemple montre que tu n'as pas saisis comment gérer les mise en forme.
Il ne faut pas multiplier les zones différentes.
Il faut utiliser de vraies dates
Il faut que ta plage "Fériés" reprennent les dates des fériés pas les "noms" des fériés.

Enfin, bref il faut tout revoir.

Au plus simple, une dernière proposition
Tu mets la date de début en B4 (une vraie date, comme dans l'exemple).

Tout s'actualise sur deux ans.

Cordialement
 

Pièces jointes

  • week-end-planning(10) (1).xlsx
    49.8 KB · Affichages: 42

job75

XLDnaute Barbatruc
Re : MFC week end

Re,

minimutch, plutôt que de bricoler votre fichier (celui du post #30 je suppose) vous feriez mieux d'essayer de comprendre et d'utiliser le fichier d'Efgé (post #35) ou le mien (post #38).

Un planning glissant sur 3 mois est en effet la meilleure solution.

Je pense aussi que vous n'avez pas compris l'importance de la feuille "Congés", pourtant indispensable.

A+
 

minimutch

XLDnaute Junior
Re : MFC week end

Merci beaucoup....
Je suis juste en remplacement et je travaille sur le fichier déjà crée. Je voulais juste le rendre plus rapide lorsque l'on change d'année sans refaire semaine/semaine les week end et jours fériés. Comprenez vous ?
 

Discussions similaires

Réponses
29
Affichages
966

Statistiques des forums

Discussions
312 331
Messages
2 087 360
Membres
103 529
dernier inscrit
moket07