Fusion automatique de cellules via macro

[nauj]

Bonsoir Forum,
J'aurais besoin de vos lumières !
Je vous transmets un fichier consignant un calendrier (jours ouvrés) composé des mois (ligne 5), des semaines (ligne 6) et des jours (ligne 7).
Ces différentes données se calculent automatiquement selon l'année choisie (cellule A1).
Je souhaiterais avoir une macro qui permettrait de transformer la ligne 5 (mois) de la façon suivante : Au lieu d'avoir le numéro du mois sur chacune des cellules, j'aimerais voir apparaitre le nom du mois correspondant de façon fusionnée sur l'ensemble des cellules. Bien entendu, cette fusion de cellules varie selon l'année définie en A1.
Le résultat attendu est illustré sur la ligne 13 (cet exemple ne présente que les premiers mois, j'attends effectivement que cette macro s'effectue sur les 12 mois de l'année)
Merci d'avance pour votre précieuse aide.

 

[job75]

Re : Fusion automatique de cellules via macro

Bonsoir nauj,

Très bien votre idée et votre fichier, bravo.

Cette macro (dans le code de la feuille) se déclanche quand on modifie A1 A2 ou A3 :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:A3")) Is Nothing Then Exit Sub
Dim plage As Range, deb As Range, cel As Range
Application.DisplayAlerts = False
Set plage = Range("A5", Cells(7, Columns.Count).End(xlToLeft).Offset(-2))
'---défusionne---
plage.UnMerge
plage.FormulaR1C1 = "=MONTH(R[2]C)"
'---fusionne---
Set deb = plage(1)
For Each cel In plage
  If IsError(cel) Then Exit Sub
  If cel <> cel.Offset(, 1) Then
    Range(deb, cel).Merge
    deb = Application.Proper(Format(DateSerial(1, deb, 1), "mmm"))
    With deb.MergeArea.Borders(xlEdgeRight)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
    End With
    Set deb = cel.Offset(, 1)
  End If
Next
End Sub

Fichier joint.

Edition : attention, dans l'année vous aurez au moins 260 jours. Le nombre de colonnes sous Excel 97/2003 n'est pas suffisant, il vous faudrait Excel 2007. A moins que vous supprimiez les jours fériés (et encore)...
Ou plus simple, que vous fassiez un tableau pour 6 mois, le choix du semestre étant donné par une liste de validation.

Bonne nuit et A+

 

[job75]

Re : Fusion automatique de cellules via macro

Bonjour nauj, le forum,

Comme je le disais dans l'Edition de mon précédent post, la création de 2 semestres est vraiment très simple, voir le fichier joint.

Une liste de validation a été créée en A2, et les définitions des noms DateDebut et DateFin ont été modifiées en conséquence.

Dans la macro, la définition de plage est simplement :

Set plage = Range("A5:EE5")

A+

 

[nauj]

Re : Fusion automatique de cellules via macro

Bonjour job75, Forum,
Merci pour votre réactivité !
Je vais tester cette macro dans la journée car le fichier que j'utilise est plus complexe (plusieurs onglets, par exemple la cellule "An" ($A$1) se trouve sur un autre onglet, etc.)
Je suis parfaitement conscient des limites de Excel 97/2003 par rapport à la version 2007, je vous remercie en tout cas de m'avoir proposé les 2 options.
A bientôt

 

[job75]

Re : Fusion automatique de cellules via macro

Re,

Un détail, j'ai juste édité les 2 macros avec ce test :

If IsError(cel) Then Exit Sub

en cas de valeurs d'erreurs (année non valide par exemple).

A+

 

[nauj]

Re : Fusion automatique de cellules via macro

Bonsoir job75, forum,
J'ai un petit souci de mise en œuvre de votre macro.
Les données "An", "DateDebut" et "DateFin" sont sur un onglet nommé (dans mon fichier) "Paramètres". Le calendrier se trouve sur un autre onglet "Activité".
J'utilise un fichier Excel 2007 permettant de travailler sur un seul onglet. La cellule initiale du mois est L2.
Pouvez vous m'éclairer ?
Merci d'avance

 

[job75]

Re : Fusion automatique de cellules via macro

Bonsoir nauj,

Voici le fichier modifié comme vous l'indiquez.

La macro se trouve bien sûr dans le code de la feuille Paramètres.

J'ai mis en rouge ce qui a été modifié :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:A3")) Is Nothing Then Exit Sub
Dim plage As Range, deb As Range, cel As Range
Application.DisplayAlerts = False
[COLOR="Red"]With Sheets("Activité")
  Set plage = .Range("L2", .Cells(4, .Columns.Count).End(xlToLeft).Offset(-2))[/COLOR]
  '---défusionne---
  plage.UnMerge
  plage.FormulaR1C1 = "=MONTH(R[2]C)"
  '---fusionne---
  Set deb = plage(1)
  For Each cel In plage
    If IsError(cel) Then Exit Sub
    If cel <> cel.Offset(, 1) Then
     [COLOR="red"] .Range[/COLOR](deb, cel).Merge
      deb = Application.Proper(Format(DateSerial(1, deb, 1), "mmm"))
      With deb.MergeArea.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
      End With
      Set deb = cel.Offset(, 1)
    End If
  Next
[COLOR="red"]  .Activate 'facultatif
End With[/COLOR]
End Sub

Edit : les noms des mois n'étaient pas centrés... J'ai corrigé.

A+

 

[nauj]

Re : Fusion automatique de cellules via macro

job75,
Cela fonctionne parfaitement !
Merci encore de votre précieuse aide.
Bonne continuation et à bientôt