Nous avons une macro qui fait deux choses principales :
1 - Elle fait fusionner certaines cellules (A1 avec A2, puis B1 avec B2) si des cellules sont identiques sur une des colonne du tableau.
2 - Elle met en couleur certaines cellules en fonction d'un critère se trouvant sur la même ligne.
Le problème est que la fusion détruit la MFC car la fusion "supprime" certaines cellules sur lesquelles la MFC est basé.
J'ai essayé de passer la MFC avant la fusion et vice-versa cela ne change rien.
Je ne sais pas si il y a une solution.
La solution de bidouillage ne serait-elle pas de "geler" le format des cellules une fois la MFC faite et avant la fusion des cellules ?
Je vous mets mon code VBA pour illustrer.
Merci d'avance !
' Mise en forme conditonnelle
'
Range("A2:W2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($W2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
ActiveWindow.SmallScroll ToRight:=19
Range("X2:AA2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AA2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
ActiveWindow.SmallScroll ToRight:=4
Range("AB2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="0"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AC2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AC2>AUJOURDHUI()"
Selection.FormatConditions(1).Interior.ColorIndex = 36
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ET(AC2<>0;AC3<AUJOURDHUI())"
Selection.FormatConditions(2).Interior.ColorIndex = 35
Range("AD2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AD2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AE2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AE2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AF2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="0"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AG2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AG2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AH2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AH2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AI2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AI2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AJ2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="0"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("A2:AJ2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False'fusion des propriété
' Fusion des cellules
Dim i As Long, j As Long, H As Long, k As Long
Application.DisplayAlerts = False 'désactive la boîte de dialogue de la fusion
'étude colonne C (3)(code propriété) pour fusion des propriétés
For i = 1 To Range("C65536").End(xlUp).Row - 1
j = i + 1
While Cells(j, 4) = Cells(i, 4)
'Fusion des colonnes se rapportant à la propriété
Range(Cells(i, 1), Cells(j, 1)).MergeCells = True
Range(Cells(i, 2), Cells(j, 2)).MergeCells = True
Range(Cells(i, 3), Cells(j, 3)).MergeCells = True
Range(Cells(i, 4), Cells(j, 4)).MergeCells = True
Range(Cells(i, 5), Cells(j, 5)).MergeCells = True
Range(Cells(i, 6), Cells(j, 6)).MergeCells = True
Range(Cells(i, 10), Cells(j, 10)).MergeCells = True
Range(Cells(i, 11), Cells(j, 11)).MergeCells = True
Range(Cells(i, 12), Cells(j, 12)).MergeCells = True
Range(Cells(i, 13), Cells(j, 13)).MergeCells = True
Range(Cells(i, 14), Cells(j, 14)).MergeCells = True
Range(Cells(i, 15), Cells(j, 15)).MergeCells = True
Range(Cells(i, 16), Cells(j, 16)).MergeCells = True
Range(Cells(i, 17), Cells(j, 17)).MergeCells = True
Range(Cells(i, 18), Cells(j, 18)).MergeCells = True
Range(Cells(i, 19), Cells(j, 19)).MergeCells = True
Range(Cells(i, 20), Cells(j, 20)).MergeCells = True
Range(Cells(i, 21), Cells(j, 21)).MergeCells = True
Range(Cells(i, 22), Cells(j, 22)).MergeCells = True
Range(Cells(i, 23), Cells(j, 23)).MergeCells = True
Range(Cells(i, 24), Cells(j, 24)).MergeCells = True
Range(Cells(i, 25), Cells(j, 25)).MergeCells = True
Range(Cells(i, 26), Cells(j, 26)).MergeCells = True
Range(Cells(i, 27), Cells(j, 27)).MergeCells = True
Range(Cells(i, 28), Cells(j, 28)).MergeCells = True
Range(Cells(i, 29), Cells(j, 29)).MergeCells = True
Range(Cells(i, 30), Cells(j, 30)).MergeCells = True
Range(Cells(i, 31), Cells(j, 31)).MergeCells = True
Range(Cells(i, 32), Cells(j, 32)).MergeCells = True
Range(Cells(i, 33), Cells(j, 33)).MergeCells = True
Range(Cells(i, 34), Cells(j, 34)).MergeCells = True
Range(Cells(i, 35), Cells(j, 35)).MergeCells = True
Range(Cells(i, 36), Cells(j, 36)).MergeCells = True
Range(Cells(i, 37), Cells(j, 37)).MergeCells = True
Range(Cells(i, 38), Cells(j, 38)).MergeCells = True
j = j + 1
Wend
Next i
'étude colonne H (8)(parcelle) pour fusion des immeubles
For H = 1 To Range("C65536").End(xlUp).Row - 1
k = H + 1
While Cells(k, 8) = Cells(H, 8)
'Fusion des colonnes se rapportant à la location et au terrier
Range(Cells(H, 7), Cells(k, 7)).MergeCells = True
Range(Cells(H, 8), Cells(k, 8)).MergeCells = True
Range(Cells(H, 9), Cells(k, 9)).MergeCells = True
H = H + 1
Wend
Next H
Application.DisplayAlerts = True 'réactive les boîtes de dialogue
End Sub
1 - Elle fait fusionner certaines cellules (A1 avec A2, puis B1 avec B2) si des cellules sont identiques sur une des colonne du tableau.
2 - Elle met en couleur certaines cellules en fonction d'un critère se trouvant sur la même ligne.
Le problème est que la fusion détruit la MFC car la fusion "supprime" certaines cellules sur lesquelles la MFC est basé.
J'ai essayé de passer la MFC avant la fusion et vice-versa cela ne change rien.
Je ne sais pas si il y a une solution.
La solution de bidouillage ne serait-elle pas de "geler" le format des cellules une fois la MFC faite et avant la fusion des cellules ?
Je vous mets mon code VBA pour illustrer.
Merci d'avance !
' Mise en forme conditonnelle
'
Range("A2:W2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($W2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
ActiveWindow.SmallScroll ToRight:=19
Range("X2:AA2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AA2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
ActiveWindow.SmallScroll ToRight:=4
Range("AB2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="0"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AC2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AC2>AUJOURDHUI()"
Selection.FormatConditions(1).Interior.ColorIndex = 36
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ET(AC2<>0;AC3<AUJOURDHUI())"
Selection.FormatConditions(2).Interior.ColorIndex = 35
Range("AD2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AD2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AE2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AE2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AF2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="0"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AG2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AG2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AH2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AH2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AI2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AI2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AJ2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="0"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("A2:AJ2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False'fusion des propriété
' Fusion des cellules
Dim i As Long, j As Long, H As Long, k As Long
Application.DisplayAlerts = False 'désactive la boîte de dialogue de la fusion
'étude colonne C (3)(code propriété) pour fusion des propriétés
For i = 1 To Range("C65536").End(xlUp).Row - 1
j = i + 1
While Cells(j, 4) = Cells(i, 4)
'Fusion des colonnes se rapportant à la propriété
Range(Cells(i, 1), Cells(j, 1)).MergeCells = True
Range(Cells(i, 2), Cells(j, 2)).MergeCells = True
Range(Cells(i, 3), Cells(j, 3)).MergeCells = True
Range(Cells(i, 4), Cells(j, 4)).MergeCells = True
Range(Cells(i, 5), Cells(j, 5)).MergeCells = True
Range(Cells(i, 6), Cells(j, 6)).MergeCells = True
Range(Cells(i, 10), Cells(j, 10)).MergeCells = True
Range(Cells(i, 11), Cells(j, 11)).MergeCells = True
Range(Cells(i, 12), Cells(j, 12)).MergeCells = True
Range(Cells(i, 13), Cells(j, 13)).MergeCells = True
Range(Cells(i, 14), Cells(j, 14)).MergeCells = True
Range(Cells(i, 15), Cells(j, 15)).MergeCells = True
Range(Cells(i, 16), Cells(j, 16)).MergeCells = True
Range(Cells(i, 17), Cells(j, 17)).MergeCells = True
Range(Cells(i, 18), Cells(j, 18)).MergeCells = True
Range(Cells(i, 19), Cells(j, 19)).MergeCells = True
Range(Cells(i, 20), Cells(j, 20)).MergeCells = True
Range(Cells(i, 21), Cells(j, 21)).MergeCells = True
Range(Cells(i, 22), Cells(j, 22)).MergeCells = True
Range(Cells(i, 23), Cells(j, 23)).MergeCells = True
Range(Cells(i, 24), Cells(j, 24)).MergeCells = True
Range(Cells(i, 25), Cells(j, 25)).MergeCells = True
Range(Cells(i, 26), Cells(j, 26)).MergeCells = True
Range(Cells(i, 27), Cells(j, 27)).MergeCells = True
Range(Cells(i, 28), Cells(j, 28)).MergeCells = True
Range(Cells(i, 29), Cells(j, 29)).MergeCells = True
Range(Cells(i, 30), Cells(j, 30)).MergeCells = True
Range(Cells(i, 31), Cells(j, 31)).MergeCells = True
Range(Cells(i, 32), Cells(j, 32)).MergeCells = True
Range(Cells(i, 33), Cells(j, 33)).MergeCells = True
Range(Cells(i, 34), Cells(j, 34)).MergeCells = True
Range(Cells(i, 35), Cells(j, 35)).MergeCells = True
Range(Cells(i, 36), Cells(j, 36)).MergeCells = True
Range(Cells(i, 37), Cells(j, 37)).MergeCells = True
Range(Cells(i, 38), Cells(j, 38)).MergeCells = True
j = j + 1
Wend
Next i
'étude colonne H (8)(parcelle) pour fusion des immeubles
For H = 1 To Range("C65536").End(xlUp).Row - 1
k = H + 1
While Cells(k, 8) = Cells(H, 8)
'Fusion des colonnes se rapportant à la location et au terrier
Range(Cells(H, 7), Cells(k, 7)).MergeCells = True
Range(Cells(H, 8), Cells(k, 8)).MergeCells = True
Range(Cells(H, 9), Cells(k, 9)).MergeCells = True
H = H + 1
Wend
Next H
Application.DisplayAlerts = True 'réactive les boîtes de dialogue
End Sub