Sujet Précédent Sujet Suivant

Comment mettre des bordures épaisses dans des cellules fusionnée

dyjatou92 Messages postés 34 Date d'inscription mercredi 15 juin 2016 Statut Membre Dernière intervention 30 septembre 2016 - 16 août 2016 à 18:11
dyjatou92 Messages postés 34 Date d'inscription mercredi 15 juin 2016 Statut Membre Dernière intervention 30 septembre 2016 - 17 août 2016 à 13:57
Bonjour,
j'ai écrit un code qui me permet de mettre une bordure épaisse à toutes les cellules non vides mais après exécution j'ai remarqué que ça ne s'applique pas aux cellules fusionnées. Comment faire svp? 
For Each Cs In Synthese.Range("A1:N400")

If Cs.Value <> "" And Cs.Value <> 0 Then
Cs.Borders(xlDiagonalDown).LineStyle = xlNone
    Cs.Borders(xlDiagonalUp).LineStyle = xlNone
    With Cs.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Cs.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Cs.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Cs.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Cs.Borders(xlInsideVertical).LineStyle = xlNone
    Cs.Borders(xlInsideHorizontal).LineStyle = xlNone
 End If
 Next Cs

4 réponses

Réponse 1 / 4
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
16 août 2016 à 19:06
Bonjour,
Fusionner des cellules n'est jamais une bonne idée. Une fusion est TOUJOURS remplaçable, pour le même effet.
Si tu y tiens toutefois : il faut d'abord "defusionner", puis mettre les bordures, puis "refusionner"
0
Réponse 2 / 4
dyjatou92 Messages postés 34 Date d'inscription mercredi 15 juin 2016 Statut Membre Dernière intervention 30 septembre 2016
17 août 2016 à 11:07
je crois avoir déjà utilisé cette solution mais ça ne marche pas
0
Réponse 3 / 4
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
17 août 2016 à 11:37
je crois avoir déjà utilisé cette solution mais ça ne marche pas

"croire" ? croire n'est jamais que ce que c'est : croire.
Montre donc cette solution que tu "crois" avoir utilisée et qui ne "marche pas"
0
Réponse 4 / 4
dyjatou92 Messages postés 34 Date d'inscription mercredi 15 juin 2016 Statut Membre Dernière intervention 30 septembre 2016
17 août 2016 à 13:57
c'est un peu long mais voilà 
For Each Cs In Synthese.Range("A1:N400")

If Cs.Value <> "" And Cs.Value <> 0 Then
Cs.Borders(xlDiagonalDown).LineStyle = xlNone
    Cs.Borders(xlDiagonalUp).LineStyle = xlNone
    With Cs.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Cs.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Cs.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Cs.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Cs.Borders(xlInsideVertical).LineStyle = xlNone
    Cs.Borders(xlInsideHorizontal).LineStyle = xlNone
 End If
 Next Cs
 Range("A2").End(xlDown).Offset(0, 2).Select
Range(ActiveCell, ActiveCell.Offset(0, 4)).Merge
Range("A2").End(xlDown).Offset(1, 0).Select
Range(ActiveCell, ActiveCell.Offset(0, 6)).Merge
Range("A2").End(xlDown).Offset(2, 0).Select
ActiveCell.Value = "GROUPES EAU GLACEE"
Range(ActiveCell, ActiveCell.Offset(0, 6)).Merge
With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .color = 6684876
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Range("A2").End(xlDown).Offset(3, 0).Select
ActiveCell.Value = "MODELES DE GROUPE EAU GLACEE PROPOSES"
Range(ActiveCell, ActiveCell.Offset(0, 3)).Merge
With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
End With
Range("A2").End(xlDown).Offset(3, 4).Select
ActiveCell.Value = "PUISSANCES FRIGORIFIQUES NOMINALES (kW)"
Range(ActiveCell, ActiveCell.Offset(0, 2)).Merge
With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
End With
Range("A2").End(xlDown).Offset(4, 0).Select
Btherm = Application.Sum(Range("B2").EntireColumn)
ActiveCell.FormulaArray = _
                        "=INDEX(Modele_Groupe,MATCH(TRUE,Puiss_Groupe>(" & Range("B2").End(xlDown).Offset(0, 0).Address & "),0))"
Range(ActiveCell, ActiveCell.Offset(0, 3)).Merge
Range("A2").End(xlDown).Offset(4, 4).Select
ActiveCell.FormulaR1C1 = _
        "=INDEX(Puiss_Groupe,MATCH(R10C1,Modele_Groupe,0))"
Range(ActiveCell, ActiveCell.Offset(0, 2)).Merge
 Range("A1:G1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
   End With
0

Discussions similaires

Couleur de fond d'une cellule excel
lorre0041 -
isophie -

7 réponses
[vba] recopier la valeur d'une cellule dans une autre feuille.
cokinoumasterflash -
cokinoumasterflash -

5 réponses
changer un format de cellule excel en vba
stephG01 -
jpleroisse -

1 réponse
Macro: Detecter si une cellule est vide.HELP
aurel7687 -
aurel7687 -

14 réponses
Comment appeler une cellule d'une autre feuille
fanjio -
ScSami -

2 réponses
Rejoignez-nous