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

dyjatou92 34 Messages postés mercredi 15 juin 2016Date d'inscription 30 septembre 2016 Dernière intervention - 16 août 2016 à 18:11 - Dernière réponse : dyjatou92 34 Messages postés mercredi 15 juin 2016Date d'inscription 30 septembre 2016 Dernière intervention
- 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
Afficher la suite 

Votre réponse

4 réponses

ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionModérateurStatut 11 avril 2018 Dernière intervention - 16 août 2016 à 19:06
0
Merci
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"
Commenter la réponse de ucfoutu
dyjatou92 34 Messages postés mercredi 15 juin 2016Date d'inscription 30 septembre 2016 Dernière intervention - 17 août 2016 à 11:07
0
Merci
je crois avoir déjà utilisé cette solution mais ça ne marche pas
Commenter la réponse de dyjatou92
ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionModérateurStatut 11 avril 2018 Dernière intervention - 17 août 2016 à 11:37
0
Merci
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"
Commenter la réponse de ucfoutu
dyjatou92 34 Messages postés mercredi 15 juin 2016Date d'inscription 30 septembre 2016 Dernière intervention - 17 août 2016 à 13:57
0
Merci
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
Commenter la réponse de dyjatou92

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.