Bordures épaisses

[envol]

Bonsoir le fil,

pour des contours épais, j'utilise ce petite code
'les 4 contour épais
Sub contour()
Range("A3:C6").BorderAround Weight:=xlMedium
End Sub

Sur un tableau de plusieurs dizaines de lignes et de colonnes, je voudrais que toutes les 2 lignes, pour chaque colonne, les 4 contoirs soient épais.

Comment faire, svp ?😕

Bonne nuit,😉

Envol

 

[Roland_M]

Re : Bordures épaisses

bonsoir

à ma connaissance, pour les bordures épaisses,
il faut malheureusement faire cellule après cellule ou ligne après ligne !

EDIT: sur une rangée ligne du bas
Range("A1:F1").Borders(xlEdgeBottom).Weight = xlThick

 

[envol]

Re : Bordures épaisses

Bonjour Roland M, le fil,

Merci pour votre réponse.

Il y a peut-être une solution du côté des MFC.
Si quelqu'un a une astuce ... ?

Merci d'avance et bon dimanche

 

[Staple1600]

Re : Bordures épaisses

Bonjour à tous


Si j'ai bien compris la question
Avec cette macro , il y aura des bordures toutes les 2 lignes.

Sub test()
Dim i As Long
For i = 1 To 20 ' ici à adapter
If Cells(i, 1).Row Mod 3 = 1 Then
Cells(i, 1).Resize(, 3).Borders.LineStyle = xlContinuous
Cells(i, 1).Resize(, 3).Borders.Weight = xlMedium
End If
Next
End Sub

 

[envol]

Re : Bordures épaisses

Bonsoir STAPLE 1600, le fil,

Oui, c'est quasi ça que je veux faire. J'ai modifié mais j'arrive pas à obtenir le quadrillage que jecherche...
en tous cas, merci pour cette réponse.😀

voici un exmple de ce que je cherche à faire...

 

[MJ13]

Re : Bordures épaisses

Bonjour Envol, Roland, JM

Voici 2 exemples à adapter.

 

[Staple1600]

Re : Bordures épaisses

Bonsoir à tous


MJ13: un petit coup de régime sur ton code ? 😉

Sub Efface_Zone()
' Efface_Zone Macro
Range("zone").Borders.LineStyle = xlNone
End Sub

 

[envol]

Re : Bordures épaisses

Bonsoir MJ13, Staple 1600, Roland M,le fil,

ces 2 ex. sont parfaits !🙂

le 2nd "NewMJ" colle tout à fait à mon projet. Merci beaucoup !

juste une petite question: "insérer la liste"... quelle liste ?
La réponse est sans doute simple, mais mon côté "novice" prend le dessus...😱

bonne soirée,

 

[MJ13]

Re : Bordures épaisses

Re

Bon, j'ai fait vite avec l'enregistreur (c'est pour cela que c'est du brut de décoffrage).

Tout est fait par rapport à la zone nommée "zone" (Crtl+F3 pour supprimer le nom zone et le redéfinir ensuite). Sinon remplacer zone par selection, ce qui donnerait:

Sub Contour_Zone()
'MJ
'Stop
'Efface_Zone
'Encadrement nbbas+1 et nbdroit+1
nbbas = Cells(1, 2) - 1
nbdroit = Cells(2, 2) - 1
Nlig = Selection.Rows.Count
Ncol = Selection.Columns.Count
'MsgBox Range("zone").Address
'Application.Goto Reference:="Zone"
NCdeb = ActiveCell.Column
nlDeb = ActiveCell.Row
For i = nlDeb To nlDeb + Nlig - 1
        For j = NCdeb To (NCdeb + Ncol - 1)
            Range(Cells(i, j), Cells(i + nbbas, j + nbdroit)).Select
            j = j + nbdroit
           Macro1'Macro pour encadrement fin de la zone
            Selection.BorderAround Weight:=xlMedium
        Next
i = i + nbbas
Next
End Sub

 

[Staple1600]

Re : Bordures épaisses

Re



Voici le code sous Excel 2000 qui fait ce qu'il y a dans ton classeur exemple (message de 18h17)

(PS:Je dois adapter le code de MJ13 por le faire fonctionner sous XL 2000)

Sub bordures()
Dim i As Long, r As Range
For i = 2 To 15
If Cells(i, 3).Row Mod 2 = 0 Then
Set r = Range(Cells(i, 3), Cells(i, 4)).Resize(2, 2)
r.Offset(-1).Borders(xlEdgeBottom).LineStyle = xlContinuous
r.Item(1).Resize(2).Borders(xlEdgeRight).LineStyle = xlContinuous
r.Resize(2).BorderAround xlContinuous, xlMedium
End If
Next
Set r = Nothing
End Sub

 

[envol]

Re : Bordures épaisses

Bonsoir MJ, Staple 1600, Roland M, le fil,

Pour comprendre comment vous faites les macros, je tente de reproduire celle de MJ13 (1_h20 / NewMJL)...mais je bloque car je sais pas tout faire.😱

Vous pouvez me donner encore un p'tit coup de main, svp ?

Ce que j'ai fait
- Placer Nbr lignes et Nbr colonnes en AB1 et AB2
- Copier à l'identique les macros sous VBA mais comment renommer les zones de saisie à côté de Nbr lignes et colonnes ?
- Affecter les macros à 2 boutons

Ce que je sais pas faire
- les 2 actions décrites colonnes J et L sur le fichier d'origine

Très bonne soirée à vous tous.

Cordialement,

 

[MJ13]

Re : Bordures épaisses

Bonjour à tous

Ce que j'ai fait
- Placer Nbr lignes et Nbr colonnes en AB1 et AB2
- Copier à l'identique les macros sous VBA mais comment renommer les zones de saisie à côté de Nbr lignes et colonnes ?
- Affecter les macros à 2 boutons

Envol: Si tu arrives à faire cela c'est déjà bien.

Ce que je sais pas faire
les 2 actions décrites colonnes J et L sur le fichier d'origine

Ce que j'avais mis, c'était juste pour facilement voir la zone nommée. Cela ne sert pas à grand chose dans ton cas.

Sinon, si c'est pour nommée une zone, le mieux est d'utilsier l'enregistreur de macros en faisant \Insertion \Nom \Définir ou mettre le nom de la zone dans la case à côté de la barre de formule et de voir le code généré en remplaçant l'adresse par selection si tu as une zone de sélectionnée.

Bon courage 🙂.

 

[envol]

Re : Bordures épaisses

Bonsoir MJ13, le fil,

si tes' ok, j'aurais besoin d'une p'tit coup de pouce pour avancer...

ce que j'ai fait sous excel 2007:
- recopier tel quel tout ton vba
- créer un bouton et affecter la macro de ton vba "macro1"

Je sais nommer une plage avec un clic droit mais je sais pas la faire prendre en compte par ta macro😱

Alors à ce stade, voilà ce que je peux faire
- je sélectionner une plage et clic sur le bouton
- le quadrillage simple s'affiche... C'est différent du résultat recherché...😱

Merci pour tes conseils.

bonne soirée,

 

[MJ13]

Re : Bordures épaisses

Bonjour Envol

recopier tel quel tout ton vba
- créer un bouton et affecter la macro de ton vba "macro1"

Le mieux serait de joindre ton fichier.

Sinon, je ne pourrais pas y travailler avant Samedi.

 

[Staple1600]

Re : Bordures épaisses

Bonsoir à tous

Une version avec paramètres

Pour tester : lancer exemple1 ou exemple2

Sub exemple1()
Cells.Clear
m1_bordures "C5", 2, xlInsideHorizontal, xlThick, 10, 2
End Sub

Sub exemple2()
Cells.Clear
m1_bordures "A3", 4, xlInsideVertical, xlMedium, 20, 3
End Sub

Sub m1_bordures(depart As String, interval As Long, TypeBord As XlBordersIndex, Trait As XlBorderWeight, nblig As Long, nbcol As Long)
    Dim i As Long, r As Range
    i = 0
    Set r = Sheets(1).Range(depart)
    Do
    With r.Offset(i * interval, 0).Resize(interval, nbcol)
    .BorderAround , LineStyle:=xlContinuous, Weight:=Trait
    .Borders(TypeBord).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    End With
    i = i + 1
    If (i + 1) * interval > nblig Then Exit Sub
    Loop
End Sub