Programmation vba quadrillage

A

alex44510

XLDnaute Junior
Bonjour à tous,

J'ai une programmation VBA qui me pose probleme.

Voila j'ai automatisé le quadrillage lorsque j'insere une nouvelle ligne dans mon tableau Excel.

Sauf que mon quadrillage s'arrete a la colonne I au lieu de la colonne J. Il y a par consequent je suis obliger faire le quadrillage automatique sur la colonne J manuellement.

Voici ma prog VBA:

Private Sub Worksheet_Activate()
Dim ws As Worksheet, fin&, fin1
Application.ScreenUpdating = 0
With Feuil1
fin = .Range("A" & Rows.Count).End(xlUp).Row
If fin < 9 Then fin = 9
.Range("A9:J" & fin).ClearContents
.Range("A9:J" & fin).Borders.LineStyle = 0
Feuil2.Rows(9).Copy .Rows(9)
.Range("A1") = "RECAPITULATIF DES RDV " & Right(.Name, 4)
For Each ws In Worksheets
If ws.Name <> "Tableau de Bord" And ws.Name <> "INFORMATION AGENCE" _
And Not ws.Name Like "RECAPITULATIF DES RDV" & "*" And ws.Name <> "RECAPITULATIF RDV PAR N°FICHE" Then
fin = .Range("A" & Rows.Count).End(xlUp).Row
fin1 = ws.Range("A" & Rows.Count).End(xlUp).Row
If fin < 9 Then fin = 9
If fin1 <= 9 Then GoTo 1
ws.Range("A10:J" & fin1).Copy Feuil1.Range("A" & fin + 1)
End If
1 Next ws
fin = .Range("A" & Rows.Count).End(xlUp).Row
If fin < 9 Then fin = 9
.Range("A9:J" & fin).Borders.LineStyle = 1
.Columns("A:A").ColumnWidth = 13: .Columns("B:B").ColumnWidth = 8
.Columns("C:C").ColumnWidth = 15: .Columns("E:E").ColumnWidth = 33
.Columns("F:F").ColumnWidth = 40: .Columns("C:C").NumberFormat = "00"
.Columns("I:I").ColumnWidth = 50: .Columns("G:G").ColumnWidth = 35:
.Columns("H:H").ColumnWidth = 15:
.Range("A10:J" & fin).Sort Key1:=Range("A10"), Order1:=xlAscending, Header:=xlNo
End With
End Sub

Merci beaucoup
 
Trier par date Trier par votes
Victor21

Victor21

XLDnaute Barbatruc
Re : Programmation vba quadrillage

Re,

alex44510 à dit:
Ok je vous le transmets ce soir. Au travail il m'est impossible d'acceder a cjoint.fr :)
Cliquez pour agrandir...
Ca tombe bien, car les fichiers déposés sur cjoint n'y restent que pendant un temps limité.
Alors que si vous allez en mode avancé, vous pouvez le joindre directement à votre message (un extrait représentatif suffit) en cliquant sur le trombonnne.
:)
 
Vote positif 0 Vote négatif
phlaurent55

phlaurent55

Nous a quittés en 2020
Repose en paix
Re : Programmation vba quadrillage

Bonjour à tous,

remplace le code par celui-ci (dans le module 1)
Code: 
Sub mp()
    Dim fin&
    With ActiveSheet
        fin = .Range("A65535").End(xlUp).Row
        .Range("A10:J10000").Borders.LineStyle = 0
        .Range("A10:J" & fin).Borders.LineStyle = 1
        
    End With
End Sub
c'était à cause de "I" au lieu de "J"

à+
Philippe
 
Dernière édition:
Vote positif 0 Vote négatif
A

alex44510

XLDnaute Junior
Re : Programmation vba quadrillage

Bonjour Patrick,

Je suis toujours bloqué même en effectuant vos modifications.

J'ai du mal intégrer des éléments. Pouvez-vous me communication ma programmation avec vos modifications?

Merci pour votre aide

Cordialement alex


phlaurent55 à dit:
Bonjour à tous,

remplace le code par celui-ci (dans le module 1)
Code: 
Sub mp()
    Dim fin&
    With ActiveSheet
        fin = .Range("A65535").End(xlUp).Row
        .Range("A10:J10000").Borders.LineStyle = 0
        .Range("A10:J" & fin).Borders.LineStyle = 1
        
    End With
End Sub
c'était à cause de "I" au lieu de "J"

à+
Philippe
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
herve62

herve62

XLDnaute Barbatruc
Supporter XLD
Re : Programmation vba quadrillage

Remplace ta Sub mp comme ca : j'ai testé ca marche

Code: 
Sub mp()
    Dim fin&
    With ActiveSheet
        fin = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A10:I10000").Borders.LineStyle = 0
        .Range("A10:J" & fin).Borders.LineStyle = 1           >   C'est ICI qu'il faut mettre J aussi
    End With
End Sub

Bonne soirée
 
Vote positif 0 Vote négatif
phlaurent55

phlaurent55

Nous a quittés en 2020
Repose en paix
Re : Programmation vba quadrillage

Re,

un peu trop rapide ma première réponse et pas testée
..... j'ai honte :(

ça ira mieux avec ceci
Code: 
Sub mp()
    Dim fin
    With ActiveSheet
        fin = .Range("A65535").End(xlUp).Row
        .Range("A10:J10000").Borders.LineStyle = 0
        .Range("A10:J" & fin).Borders.LineStyle = 1
    End With
End Sub

à+
Philippe
 
Dernière édition:
Vote positif 0 Vote négatif
JCGL

JCGL

XLDnaute Barbatruc
Re : Programmation vba quadrillage

Bonjour à tous,
Salut Philippe,

Avec le code de l'ami Philippe et Dépot sur XLD pour que cette discussion ait encore un sens dans quelques jours...

VB: 
Option Explicit


Sub MeF()
    Dim DerL&
    DerL = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row


    Application.ScreenUpdating = 0


    With ActiveSheet
        .Range("A9:J" & DerL + 100).Borders.LineStyle = xlNone
        .Range("A9:J" & DerL).Borders.LineStyle = 1    '12
    End With


End Sub

A++
A + à tous
 
Vote positif 0 Vote négatif
A

alex44510

XLDnaute Junior
Re : Programmation vba quadrillage

Bonjour Messieurs,

Tout d'abord merci à vous pour vos réponses.
J'ai essayé vos deux propositions mais aucune d'entre elle ne fonctionne (il faut préciser que je suis débutant sur vba). J'éprouve des difficultés à insérer vos réponses dans ma programmation.

Ou dois-je insérer vos programmations dans cell ci-dessous ? :

Option Explicit

Private Sub Worksheet_Activate()
Dim ws As Worksheet, fin&, fin1
Application.ScreenUpdating = 0
With Feuil1
fin = .Range("A" & Rows.Count).End(xlUp).Row
If fin < 9 Then fin = 9
.Range("A9:J" & fin).ClearContents
.Range("A9:J" & fin).Borders.LineStyle = 0
Feuil2.Rows(9).Copy .Rows(9)
.Range("A1") = "RECAPITULATIF DES RDV " & Right(.Name, 4)
For Each ws In Worksheets
If ws.Name <> "Tableau de Bord" And ws.Name <> "INFORMATION AGENCE" _
And Not ws.Name Like "RECAPITULATIF DES RDV" & "*" And ws.Name <> "RECAPITULATIF RDV PAR N°FICHE" Then
fin = .Range("A" & Rows.Count).End(xlUp).Row
fin1 = ws.Range("A" & Rows.Count).End(xlUp).Row
If fin < 9 Then fin = 9
If fin1 <= 9 Then GoTo 1
ws.Range("A10:J" & fin1).Copy Feuil1.Range("A" & fin + 1)
End If
1 Next ws
fin = .Range("A" & Rows.Count).End(xlUp).Row
If fin < 9 Then fin = 9
.Range("A9:J" & fin).Borders.LineStyle = 1
.Columns("A:A").ColumnWidth = 13: .Columns("B:B").ColumnWidth = 8
.Columns("C:C").ColumnWidth = 15: .Columns("E:E").ColumnWidth = 33
.Columns("F:F").ColumnWidth = 40: .Columns("C:C").NumberFormat = "00"
.Columns("I:I").ColumnWidth = 50: .Columns("G:G").ColumnWidth = 35:
.Columns("H:H").ColumnWidth = 15:
.Range("A10:J" & fin).Sort Key1:=Range("A10"), Order1:=xlAscending, Header:=xlNo
End With
End Sub

Merci à vous pour votre aide
 
Vote positif 0 Vote négatif
phlaurent55

phlaurent55

Nous a quittés en 2020
Repose en paix
Re : Programmation vba quadrillage

Re,

Pour info si vous n'avez pas compris mon message
Cliquez pour agrandir...
Pour info, le message a été compris
.......... mais n'étant pas liés par contrat avec XLD et n'étant pas obligés d’être connectés en permanence, aucun intervenant ne sera jamais capable de répondre avant d'avoir pris connaissance de la question

En publicité cette semaine chez Auch... ; La PATIENCE en seaux de 10 litres

ton fichier en retour
pour info également, ça fonctionne uniquement dès qu'on met une date en colonne A

à+
Philippe
 

Pièces jointes

  • 111.zip
    180.5 KB · Affichages: 104
  • 111.zip
    180.5 KB · Affichages: 102
  • 111.zip
    180.5 KB · Affichages: 118
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Programmation vba quadrillage

Bonjour à tous,

Pas suivi ce fil mais je crois comprendre qu'on veut appliquer des bordures sur un tableau dynamique.

Sans VBA c'est facile avec une Mise en forme conditionnelle (MFC).

Exemple simple sur le fichier joint.

A+
 

Pièces jointes

  • Quadrillage(1).xls
    25.5 KB · Affichages: 82
Vote positif 0 Vote négatif

Discussions similaires

C
  • Résolu(e)
Microsoft 365 Amélioration Macro.
Réponses
7
Affichages
327
crazy
C
_l_ours
  • Résolu(e)
XL 2016 Macro Dim c As Range, i As Long
Réponses
8
Affichages
226
mapomme
mapomme
I
  • Question
Microsoft 365 Déplacer la ligne visible après le filtre
Réponses
3
Affichages
274
iliess
I
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
363
M@xu3L
M
A
  • Question
Microsoft 365 Code VBA Envoi contenu tableau Excel par Email
Réponses
1
Affichages
120
Phil69970
Phil69970
chaelie2015
  • Question
XL 2013 Réduire un code
Réponses
0
Affichages
242
chaelie2015
chaelie2015
R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
160
rebatte
R
S
  • Résolu(e)
XL 2016 Besoin d'aide pour un code d'extraction
Réponses
14
Affichages
274
Phil69970
Phil69970
L
  • Résolu(e)
Microsoft 365 Suppression de cellules vide
Réponses
3
Affichages
184
Le Rouky
L
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
932
thivame
T

Membres actuellement en ligne

18 membres et 119 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 219
Messages
2 086 369
Membres
103 197
dernier inscrit
sandrine.lacaussade@orang