Autres Bordures tableau vba

candice**

XLDnaute Nouveau
Bonjour,

J'ai effectuer un code pour créer des bordures à mon tableau en vérifiant chaque cellule mais celui ci ne veut pas s'exécuter quelqu'un pourrait m'aider à trouver l'erreur?

Merci d'avance ci joint mon code.



VB:
Sub Bordures()
Sheets("ce0").Unprotect

x = Sheets("ce0").Cells(18, 60).End(xlDown).Row - 17
y = Sheets("ce0").Cells(18, 60).End(xlToRight).Column - 59

Sheets("ce0").Select


For J = 1 To y
If J<=5 Then
    For I = 1 To x
    If I<=15 Then
        If Sheets("mesures").Cells(59 + J, 17 + I) <> "" Then
            Cells(59 + J, 17 + I).Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
        End If
        End If
    Next I
    Exit For
End If
Next J
    
Sheets("ce0").Protect
End Sub
 

Robert

XLDnaute Barbatruc
Bonjour Candice, bonjour le forum,

Ton problème n'est pas clair, en tous cas pour moi.

J'ai effectuer un code pour créer des bordures à mon tableau en vérifiant chaque cellule mais celui ci ne veut pas s'exécuter quelqu'un pourrait m'aider à trouver l'erreur?
Que veut tu dire par ne veux pas s'exécuter ?
Il y a-t-il une erreur avec un message d'erreur et une ligne surlignée de jaune ?
Il ne se passe rien après l'exécution de la macro ?

Si tu veux de l'aide plus rapidement je te conseille de joindre le fichier qui va bien et d'être plus claire sur tes explications.
 

candice**

XLDnaute Nouveau
Bonjour @Robert,

Ce que je veux dire est que ma macro s’exécute correctement mais il ne se passe rien c'est pour cela que je pense avoir une erreur dans mon code mais je ne la trouve pas.

Merci pour ton aide
 

Robert

XLDnaute Barbatruc
Re,

Avec un fichier c'est plus simple !... Dans un premier temps j'ai rajouté juste à près la seconde boucle du For I la ligne :

VB:
Debug.Print Cells(59 + J, 17 + I).Address(0, 0)
Et à la fin de la macro je lis dans la fenêtre d'exécution ([Ctrl]+[G] dans VBE) que tu vérifies la valeur des cellules de la plage R60:AF60 qui est vide !
Donc visiblement tu t'es mélangé les pinceaux quelque part entre les I et les J. Ensuite un Exit For juste après le Next I fait que tu ne feras jamais qu'une seule ligne... Si je supprimes ce Exit for la plage vérifiée devient R60:AF64. Je te laisse le soin de corriger tes erreurs.
 

candice**

XLDnaute Nouveau
Merci pour ton aide @Robert je n'avais pas remarqué que j'avait inversé mes I et mes J.
J'ai un autre problème car ma macro ne fait toujours pas les bordures que je souhaite faire.
Aurais tu une solution?

Merci d'avance
 

candice**

XLDnaute Nouveau
VB:
Sub Bordures()
Sheets("ce0").Unprotect

x = Sheets("ce0").Cells(18, 60).End(xlDown).Row - 17
y = Sheets("ce0").Cells(18, 60).End(xlToRight).Column - 59

Sheets("ce0").Select


For J = 1 To y
If J <= 5 Then
    For I = 1 To x
    If I <= 15 Then
    Debug.Print Cells(17 + I, 59 + J).Address(0, 0)
        If Sheets("mesures").Cells(17 + I, 59 + J) <> "" Then
            Cells(17 + I, 59 + J).Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
        End If
        End If
    Next I
    End If
    Exit For
Next J
    
Sheets("ce0").Protect
End Sub
 

Robert

XLDnaute Barbatruc
Re,

Je ne comprend pas où tu veux en venir. Première boucle, tu compares avec la valeur de la cellule BH19 de l'onglet mesures mais elle est forcément vide. C'est avec A55 de cet onglet qu'il faudrait comparer me semble-t-il...
Écoute là je suis dispo, si ça te convient, envoie-moi par mail perso un numéro de téléphone que je puisse te joindre et tu pourras m'expliquer...
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, candice**, Robert

candice**
Quand miction rime avec violon...:rolleyes:
 
Dernière édition:

Robert

XLDnaute Barbatruc
Bonjour Staple, bonjour le forum,

Je ne l'avais pas vue celle-là... Je vais vider mon instrument, il est plein...
 

Staple1600

XLDnaute Barbatruc
Bonjour Robert

[pensées du samedi matin (mais pas à Berlin)]
Comment se fait-ce que les propositions que nous laissons ici soient si vite oubliées par les demandeurs?
Et ce de plus en plus souvent...
Tu peux me le dire?
Car cela me bouleversifie chaque jour un peu plus, et mine mon teint.
Il arrive même qu'une larme perle sur ma joue gauche le soir venu, quand derrière mon écran, j'assiste impuissant à ce non-rémploi des codes que nous avons ciselé sur notre établi VBE, avec dévotion et sens du partage.
[/pensées du matin]
 

Robert

XLDnaute Barbatruc
Re,

Éternel problème qui ne date pas d'aujourd'hui, hélas !... Comme toi, ça me gave mais finalement je me dis que tant qu'on joue, on gagne...
 
Haut Bas