Ajouter une ligne qui trace les bordures à une macro déjà fonctionnelle

**INFINITY100** · 04/05/2015, 14h34

Bonjour tous le monde

Voila ci-dessous j'ai une macro qui fonctionne très à un détail pré, en effet je voudrai que quand les données sont envoyées à la page voulu les cases soit avec des bordure horizontales et verticales en format simples

Merci d'avance pour votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Private Sub AjoutNouveauFournisseur_Click()
 
  Dim Ctrl As Control
  Dim r As Integer
  Dim Derligne As Integer
  Dim LigneDebut As Long
  Dim Ligne As Long, Celluledebut As Integer, Cellulefin As Integer
  Dim Celluledebut2 As Integer, Cellulefin2 As Integer
 
  With Worksheets("Liste_Fournisseurs")
      LigneDebut = 12
      Derligne = .Range("C" & Cells.Rows.Count).End(xlUp).Row + 1
      Ligne = Derligne
      Celluledebut = 3: Cellulefin = 8
            .Range(.Cells(Ligne, Celluledebut), .Cells(Ligne, Cellulefin)).Merge
             Celluledebut2 = 9: Cellulefin2 = 21
      .Range(.Cells(Ligne, Celluledebut2), .Cells(Ligne, Cellulefin2)).Merge
      For Each Ctrl In AjoutFournisseurs.Controls
        r = Val(Ctrl.Tag)
        If r > 0 Then .Cells(Derligne, r) = Ctrl
      Next
      End With
      Fourniseurs_TextBox = ""
      Fourniseurs_TextBox.SetFocus
   End Sub

Cordialement

**joe.levrai** · 04/05/2015, 14h47

Bonjour,

il te suffit d'utiliser l'enregistreur de macro : tu mets les bordures sur une cellule au hasard

tu as la base du code à intégrer dans ta procédure

les bordures sont visiblement à positionner dans ton If en ligne 20

**INFINITY100** · 04/05/2015, 15h02

Merci Joe.levrai

Voila j'ai suivi ta procédure et ça ma généré ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub Macro1()
    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 Sub

Existe t-il un moyen de résumé tout cela ?

Merci

**joe.levrai** · 04/05/2015, 15h06

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
With Selection.Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
End With

**INFINITY100** · 04/05/2015, 15h31

J'ai appliqué cela mais ça ne donne toujours rien

voila le résultat ce que j'ai ajouté c'est en rouge

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Sub AjoutNouveauFournisseur_Click()
  
  Dim Ctrl As Control
  Dim r As Integer
  Dim Derligne As Integer
  Dim LigneDebut As Long
  Dim Ligne As Long, Celluledebut As Integer, Cellulefin As Integer
  Dim Celluledebut2 As Integer, Cellulefin2 As Integer
  
 With Worksheets("Liste_Fournisseurs")
      LigneDebut = 12
      Derligne = .Range("C" & Cells.Rows.Count).End(xlUp).Row + 1
      Ligne = Derligne
      Celluledebut = 3: Cellulefin = 8
            .Range(.Cells(Ligne, Celluledebut), .Cells(Ligne, Cellulefin)).Merge
             Celluledebut2 = 9: Cellulefin2 = 21
      .Range(.Cells(Ligne, Celluledebut2), .Cells(Ligne, Cellulefin2)).Merge
      For Each Ctrl In AjoutFournisseurs.Controls
        r = Val(Ctrl.Tag)
                If r > 0 Then .Cells(Derligne, r) = Ctrl
             With Selection.Borders
                  .LineStyle = xlContinuous
                  .Weight = xlThin
                   End With
                Next
         End With
      Fourniseurs_TextBox = ""
      Fourniseurs_TextBox.SetFocus
   End Sub

**joe.levrai** · 04/05/2015, 15h55

Bonjour,

la cellule dans ton code n'est pas "Selection", mais ".Cells(Derligne, r)"

il faut adapter, je t'ai donné un exemple

**INFINITY100** · 04/05/2015, 16h14

Re bonjour

étant nul en VBA là je me pers complément

j'ai essayé ceci rien

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
With Cells(Derligne, r).Borders
                  .LineStyle = xlContinuous
                  .Weight = xlThin
                   End With

vous serez gentil si tu me renvoi la macro avec le code voulu car franchement j'arrive pas à l'intégré comme il se doit

Merci encore

**joe.levrai** · 04/05/2015, 16h25

il suffit d'écrire correctement ce que j'ai indiqué : .Cells(Derligne, r)

le point a toute son importance

**INFINITY100** · 04/05/2015, 16h35

Et voila le tout ça donne erreur débogage "erreur définie par l'application ou par objet"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Private Sub AjoutNouveauFournisseur_Click()
  Dim Ctrl As Control
  Dim r As Integer
  Dim Derligne As Integer
  Dim LigneDebut As Long
  Dim Ligne As Long, Celluledebut As Integer, Cellulefin As Integer
  Dim Celluledebut2 As Integer, Cellulefin2 As Integer 
 
With Worksheets("Liste_Fournisseurs")
      LigneDebut = 12
      Derligne = .Range("C" & Cells.Rows.Count).End(xlUp).Row + 1
      Ligne = Derligne
      Celluledebut = 3: Cellulefin = 8
            .Range(.Cells(Ligne, Celluledebut), .Cells(Ligne, Cellulefin)).Merge
             Celluledebut2 = 9: Cellulefin2 = 21
      .Range(.Cells(Ligne, Celluledebut2), .Cells(Ligne, Cellulefin2)).Merge
      For Each Ctrl In AjoutFournisseurs.Controls
        r = Val(Ctrl.Tag)
        If r > 0 Then .Cells(Derligne, r) = Ctrl
        With     .Cells(Derligne, r).Borders
                   .LineStyle = xlContinuous
                   .Weight = xlThin
                   End With
                Next
         End With
      Fourniseurs_TextBox = ""
      Fourniseurs_TextBox.SetFocus
   End Sub

**joe.levrai** · 04/05/2015, 16h49

Bonjour,

c'est le B.A. du VBA ton problème là ... je veux bien aider, mais faut quand même que tu te mettes sérieusement à maîtriser la base, il y a quantité des tutoriels à ce sujet sur le forum (sans parler de la FAQ)

tu as deux manières d'écrire une condition If... Then ... (End If)

méthode 1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If VarS = "Toto" Then Exit Sub

on ne gère que la condition vérifiée et on a une seule action à réaliser : on peut tout mettre sur une ligne et on utilise pas le End If

méthode 2
Si tu dois gérer le cas où ta condition se vérifie et le cas où elle ne se vérifie pas OU si tu as plusieurs actions à réaliser, la structure de ton If devient :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
If Vars = "Toto" Then
    Exit Sub
Else
    Cells(1,1) = Vars
    Cells(1,2) = Vars & " Check"
End if

donc voici le travail complètement mâché

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
With .Cells(Derligne, r)
    If r > 0 Then
        .Value = Ctrl
        
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    End If
End With

**INFINITY100** · 05/05/2015, 14h37

Merci beaucoup cher ami

Ajouter une ligne qui trace les bordures à une macro déjà fonctionnelle [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager