Discussion :

[thibault.mourichon]

Bonjour

J'ai développé une application via VBA et tout fonctionne correctement, toutefois pour plus de clarté je souhaitais mettre en forme les cellules après l'ajout dans la feuille.

Voila se que j'ai fais mais je n'arrive pas a automatiser le formatage sur tous les ajouts

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
Sub Addme()
'***********************************************************************************
'Procédure permettant de rajouter la ligne de données dans le FTU
'************************************************************************************
    Set NextRow = Sheets("Contact").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
 
 
    For X = 1 To Cnum
        NextRow = Me.Controls(Ref & X).Value ' On récupère les valeurs des controls
        Set NextRow = NextRow.Offset(0, 1) ' on les insères dans la colonnes
 
    Next X
 
    Range("I11:K11").Select
    Range("K11").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
 
End Sub

merci de votre aide!

[Wololol]

Bonjour,

Si j'ai bien compris ta demande tu auras besoin d'un code de ce type :

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
Dim NextRow As Range
nblig = Sheets("Contact").Cells(Rows.Count, 2).End(xlUp).Row
Set NextRow = Sheets("Contact").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
For X = 1 To Cnum
NextRow = 5 ' On récupère les valeurs des controls
Set NextRow = NextRow.Offset(0, 1) ' on les insères dans la colonnes
Next X
 
With Range(Cells(nblig, 2) & ":" & Cells(nblig, Cnum))
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
    With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    .Merge
End With

A tester et à adapter.

J’espère l'avoir appliquer au bonne cellules, car ton Range("I11:K11").Select me donne des doutes.

Bonne journée

[thibault.mourichon]

Salut Merci pour ton retour, mais j'ai donné le mauvais sub ....

j'ai essayé d'appliquer le code sur le bon Sub mais cela ne fonctionne pas...

les variables ont été déclaré

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
41
42
 
 Sub Addme2()
'***********************************************************************************
'Procédure permettant de rajouter la ligne de données dans le FTU
'************************************************************************************
   'Déclaration des variables
 
Dim Cnum As Integer
Dim X As Integer
Dim NextRow As Range
Dim NextColumns As Range
Dim Ref As String
 
 
nblig = Sheets("F.T.U").Cells(11, Columns.Count).End(xlToLeft).Row
Set NextRow = Sheets("F.T.U").Cells(11, Columns.Count).End(xlToLeft).Offset(0, 3)
For X = 1 To Cnum
NextRow = Me.Controls(Ref & X).Value ' On récupère les valeurs des controls
Set NextRow = NextRow.Offset(0, 2) ' on les insères dans la colonnes
Next X
 
With Range(Cells(nblig, 2) & ":" & Cells(nblig, Cnum))
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
    With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    .Merge
End With
 
End Sub

Merci pour votre retour

[Wololol]

Re,

J'avoue ne pas trop comprendre ton programme :

Ton nblig va toujours contenir 11, car tu prend la ligne 11 et tu compte le nombre de colonne, puis récupère la coordonnée de la ligne

De plus pourquoi que la ligne 11 ? Tu ne veux pas appliquer le style à chaque nouvelle ligne ?

Peux-tu expliquer vraiment comment tu insère tes données comme ça on pourra résoudre ton problème, je pense personnellement qu'on peut se passer de l'Offset qui complique un peu trop le programme

Bonne fin de journée

[thibault.mourichon]

J'essaie de t'envoyer le fichier mais la taille dépasse la limite autorisé par le forum, mais en gros je fais une application pour mes techniciens, il doivent gerer l'avancement de leur chantier et facturer en fonction d'un pourcentage d'avancement.
une partie des données sont enregistré via un Userform et un second userform complète certaine données dans un même tableau





tu peux essayer de télécharger le fichier depuis
https://drive.google.com/open?id=13d...zlDbPweOdfjaMU

En te remerciant

[Wololol]

Re,

Pour voir si j'ai bien compris ta demande je t'ai créer deux méthodes de copie et de modification de format (en conservant ton style d'insertion), je pense qu'il doit y en avoir de mieux mais voici :

Méthode 1:

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
Private Sub CommandButton1_Click()
Dim NextRow As Range
Cnum = 3 ' j'ai mis ça car je ne sais pas comment tu récupère la valeur
 
Set NextRow = Sheets("Feuil1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
 
For X = 1 To Cnum
NextRow = "Test 1" 'Me.Controls(Ref & X).Value ' On récupère les valeurs des controls
With NextRow
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
    With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
 
 
    End With
End With
 
Set NextRow = NextRow.Offset(0, 1) ' on les insères dans la colonnes
 
Next X
 
End Sub

Méthode 2 :

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
41
42
43
44
Private Sub CommandButton2_Click()
Dim NextRow As Range
Cnum = 3
With Sheets("Feuil1").Range("A1") ' format de référence sauvegarder dans cette cellule
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
 
 
    End With
    End With
 
 
 
 
 
 
 
Set NextRow = Sheets("Feuil1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
 
Range("A1").Copy 'on copie la cellule de ref
 
For X = 1 To Cnum
NextRow = "Test 2" 'Me.Controls(Ref & X).Value ' On récupère les valeurs des controls
 
NextRow.PasteSpecial xlPasteFormats
 
Set NextRow = NextRow.Offset(0, 1) ' on les insères dans la colonnes
 
Next X
 
End Sub

Et le petit fichier test pour voir si c'était ce que tu voulais

Bonne journée