Macro qui fonctionne dans un fichier Excel mais pas dans un autre

Version imprimable

Bonjour,

J'ai récupéré une macro dans un fichier, qui coloris des lignes et change la Font du texte en fonction de variables.

Cela fonctionne très bien dans le fichier d'origine, mais pas dans le nouveau fichier.

Quelles pourraient-être les causes ?

Merci

Voici le code : (j'ai mis du texte pour m'y retrouver car je débute en VBA ;-)) )

Code:

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Option Explicit
 
Sub crea_recherche()        'Mise en forme ligne
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
Dim i As Double
Dim post As Double
Dim derlign As Double
Dim test As Variant
 
Sheets("travail").Activate                          'onglet travail actif
 
derlign = Range("A" & Rows.Count).End(xlUp).Row     'dernière ligne colonne A
 
For post = 13 To derlign                            'Post= ligne 13 à dernière ligne
 
If Range("F" & post) = "" Then                      'Si colonne G vide
 
Range("A" & post, "G" & post).Select                'Sélection Colonne A à G
    With Selection
        .HorizontalAlignment = xlCenter             'centrage texte
        .VerticalAlignment = xlBottom
    End With
    With Selection.Interior
        .ThemeColor = xlThemeColorLight2            'Fond de couleur
        .TintAndShade = 0.399975585192419
    End With
    With Selection.Font                             'Police Arial ...
        .Name = "Arial"
        .Size = 11
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True                      'Gras
    Selection.Merge
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)               'Bordure
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)            'Bordure
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
 
End If
 
Next post
 
Sheets("travail").Activate
 
Application.ScreenUpdating = True           'Mise à jour travail
Application.DisplayAlerts = True
 
End Sub

10/04/2020, 22h25
a_diard

Utilise le pas a pas pour trouver ce qui se passe.

ou ce qui ne se passe pas.

Je crois qu'il est possible et souhaitable de supprimer la plupart des select.

En réutilisant ton code.

Code:

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
 
Sub crea_recherche2() 'Mise en forme ligne
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
Dim i As Double
Dim post As Double
Dim derlign As Double
Dim test As Variant
 
Sheets("travail").Activate 'onglet travail actif
 
derlign = Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne colonne A
 
For post = 13 To derlign 'Post= ligne 13 à dernière ligne
 
If Range("F" & post) = "" Then 'Si colonne G vide
 
 'Sélection Colonne A à G
With Range("A" & post, "G" & post)
.HorizontalAlignment = xlCenter 'centrage texte
.VerticalAlignment = xlBottom
End With
With Range("A" & post, "G" & post).Interior
.ThemeColor = xlThemeColorLight2 'Fond de couleur
.TintAndShade = 0.399975585192419
End With
With Range("A" & post, "G" & post).Font 'Police Arial ...
.Name = "Arial"
.Size = 11
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Range("A" & post, "G" & post).Font.Bold = True 'Gras
Range("A" & post, "G" & post).Merge
With Range("A" & post, "G" & post).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range("A" & post, "G" & post).Borders(xlEdgeTop) 'Bordure
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range("A" & post, "G" & post).Borders(xlEdgeBottom) 'Bordure
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range("A" & post, "G" & post).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
 
End If
 
Next post
 
Sheets("travail").Activate
 
Application.ScreenUpdating = True 'Mise à jour travail
Application.DisplayAlerts = True
 
End Sub

10/04/2020, 22h41
Olivier2610

Merci pour ce retour.

J'ai copié ce code dans un nouveau module, mais il ne se passe rien non plus.

Question bête peut-être mais comment se déclenche cette macro ?
10/04/2020, 23h37
Philippe Tulliez

Bonjour,
Après une lecture rapide du code publié, je constate que l'on ne précise pas l'objet classeur donc la procédure utilise le classeur actif

Bonjour,

Ton code corrigé et entièrement commenté :

Code:

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
Option Explicit
Sub crea_recherche()
' Mise en forme ligne
Dim feuille As Worksheet     'feuille
Dim post As Long             'il faut un entier Long au lieu d'une nombre à virgule Double
Dim derlign As Long          'idem
    Application.ScreenUpdating = False                          'Arrêter la mise à jour de l'affichage
    Set feuille = ActiveWorkbook.Worksheets("travail")          'Classeur et onglet concernés, il est préférable d'écrire :
'   Set feuille = Workbooks("LeClasseur").Worksheets("travail") '(pour éviter tout risque d'erreur de classeur).
    With feuille                                                'Actions sur la feuille du classeur :
        derlign = .Range("A" & .Rows.Count).End(xlUp).Row       '- dernière ligne colonne A de la feuille
        For post = 13 To derlign                                ' - pour Post = ligne 13 à dernière ligne
            If .Range("F" & post) = "" Then                     '  - si colonne G de la feuille est vide :
                With .Range("A" & post, "G" & post)             '   Actions sur les cellules des colonnes A à G de la feuille :
                    .HorizontalAlignment = xlCenter             '   - centrage texte
                    .VerticalAlignment = xlBottom               '   - bas
                    .Merge                                      '   - fusionnées
                    With .Interior                              '     Actions sur le fond des cellules
                        .ThemeColor = xlThemeColorLight2        '     - couleur du thème
                        .TintAndShade = 0.399975585192419       '     - teinte
                    End With                                    '     fin des actions sur le fond
                    With .Font                                  '     Actions sur le Police des cellules
                        .Name = "Arial"                         '     - Arial
                        .Size = 11                              '     - taille
                        .ThemeColor = xlThemeColorDark1         '     - couleur du thème
                        .TintAndShade = 0                       '     - teinte
                        .Bold = True                            '     - Gras
                    End With                                    '     fin des actions sur la police
                    With .Borders                               '     Actions sur les bordures (tout le tour) des cellules
                        .LineStyle = xlContinuous               '     - style de trait
                        .ColorIndex = 0                         '     - couleur
                        .TintAndShade = 0                       '     - teinte
                        .Weight = xlMedium                      '     - épaisseur
                    End With                                    '     fin des actions sur les bordures
                End With                                        '   fin des actions sur les cellules A à G
            End If                                              '  - fin de la condition (G est vide)
        Next post                                               ' - fin de la boucle post
        .Activate                                               '- Activer la feuille
    End With                                                    'fin des actions sur la feuille
    Application.ScreenUpdating = True                           'Réactiver la mise à jour de l'affichage
End Sub

11/04/2020, 14h20
Olivier2610

Bonjour,

Merci pour ce retour super précis. Ok ça fonctionne quand j'exécute la macro depuis la fenêtre VBA, par contre comment faire pour que celle-ci fonctionne dès qu'il y a des lignes insérées ?
(sur l'ancien fichier, cela se faisait automatiquement à l'insertion de lignes)

Merci.
11/04/2020, 14h28
Patrice740

Citation:

Envoyé par Olivier2610

Bonjour,
Merci pour ce retour super précis. Ok ça fonctionne quand j'exécute la macro depuis la fenêtre VBA, par contre comment faire pour que celle-ci fonctionne dès qu'il y a des lignes insérées ? (sur l'ancien fichier, cela se faisait automatiquement à l'insertion de lignes)
Merci.

Comment procèdes-tu pour insérer une ou des lignes ?
11/04/2020, 16h44
Olivier2610

J'ai une autre macro qui insère les données via une autre "feuille" vba sur la feuille "travail" avec des combobox.
Je dois avouer que sur l'autre fichier excel d'un collègue qui me sert de base pour construire le mien, je ne vois pas ce qui donne l'instruction pour déclencher cette macro de mise en forme des lignes. Cela se fait dès que la première macro insère des lignes de références.

Citation:

Envoyé par Patrice740

Comment procèdes-tu pour insérer une ou des lignes ?
11/04/2020, 19h22
Patrice740

Citation:

Envoyé par Olivier2610

J'ai une autre macro qui insère les données ....

Et c'est quoi, le code de cette macro ?

Si je ne prends que le code des CommandButton ça donne ça : (j'ai mis pas mal de commentaire pour moi).

Code:

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
Private Sub CommandButton1_Click()
'Bouton "Ajout"
 
'Ajout des éléments Choix dans case Détail poste ListBox1
ListBox1.AddItem TextBox_choix.Value
'Ajout qté dans 2ème case Détail poste ListBox2
ListBox2.AddItem TextBox_Qte.Value
 
'Remise à 0 des cases supérieures
TextBox_Qte.Value = ""
TextBox_choix.Value = ""
ListBox_dep.Clear
ComboBox_htdep.Clear
ComboBox3.Clear
 
ComboBox_inf_Change
ComboBox_acc_Change
 
End Sub
 
Private Sub CommandButton2_Click()  'Bouton "Validation poste"
 
Dim copie1 As String
Dim copie2 As String
Dim derlign As Double
Dim i As Long
Dim test As Variant
 
Sheets("travail").Select            'sélection feuille Travail
 
For i = 1 To ListBox1.ListCount     'liste les produits dans Détail Poste (ListBox1)
 
copie1 = ListBox1.List(i - 1)       'copie de la liste Détail Poste
 
Range("L" & i) = copie1             '
 
copie2 = ListBox2.List(i - 1)       'liste les Qté dans Détail Poste (ListBox2)
 
Range("Q" & i) = copie2
 
test = Range("Q" & i).Value         'Test = Valeur colonne Q et liste Détail Poste
 
If Not test = "" Then
 
    Range("N" & i).Formula = "=VLOOKUP(L" & i & ",'base de donnée'!$B$1:$L$8000,10,FALSE)"           'P.U
    Range("O" & i).Formula = "=VLOOKUP(L" & i & ",'base de donnée'!$B$1:$L$8000,6,FALSE)*Q" & i      'DEEE
    Range("P" & i).Formula = "=VLOOKUP(L" & i & ",'base de donnée'!$B$1:$L$8000,7,FALSE)"            'DEA
    Range("R" & i).Formula = "=Q" & i & "*N" & i                                                'Prix TOTAL
 
        'Ancien code
        'Range("N" & i).Select           'Colonne Poids
        'ActiveCell.FormulaR1C1 = _
        '   "=VLOOKUP(RC[-2],'base de donnée'!R2C1:R911C9,10,FALSE)"
 
        'Range("O" & i).Select           'Colonne DEEE
        'ActiveCell.FormulaR1C1 = _
        '    "=VLOOKUP(RC[-3],'base de donnée'!R2C2:R911C9,3,FALSE)"
 
        'Range("P" & i).Select           'Colonne DEA
        'ActiveCell.FormulaR1C1 = _
        '   "=VLOOKUP(RC[-4],'base de donnée'!R2C1:R911C9,7,FALSE)*RC[1]"
 
        'Range("R" & i).Select           'Colonne
        'ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-3]"
 
End If
 
Next i
 
i = i - 1
 
Range("L1 :R" & i).Copy                             'Copie sélection coller provisoirement en colonne LMNOPQR
 
derlign = Range("A" & Rows.Count).End(xlUp).Row     'dernière ligne colonne A
derlign = derlign + 1                               'dernière ligne +1
 
Cells(derlign, 1).Select                            'Sélection dernière ligne
ActiveSheet.Paste                                   'Collage
 
Range("L:S").ClearContents                          'Efface Colonne L à S
 
ListBox1.Clear                                      'Efface Détail Poste
ListBox2.Clear                                      'Efface Qté Détail Poste
TextBox2.Value = ""                                 'Efface Poste
 
End Sub
 
Private Sub CommandButton3_Click()
'Bouton "Annulation de poste"
 
Application.ScreenUpdating = False
 
ListBox1.AddItem TextBox_choix.Value    'Ajout dans Détail poste du Choix
ListBox2.AddItem TextBox_Qte.Value      'Ajout dans Qté détail poste de Qté
TextBox_Qte.Value = ""                  'Remise à 0 case Qté
TextBox_choix.Value = ""                'Remise à 0 case Choix
ListBox_dep.Clear                       'Remise à 0 ListBox
ComboBox_htdep.Clear                    'Remise à 0 Hauteur
ComboBox3.Clear                         'Remise à 0 Dimensions
 
ComboBox_inf_Change                     'Remise à 0 Infra
ComboBox_acc_Change                     'Remise à 0 Accessoires
 
Sheets("travail").Activate              'Activation onglet Travail
 
Range("L:L").ClearContents              'Efface colonne L
Range("R:R").ClearContents              'Efface colonne R
 
ListBox1.Clear                          'Efface Détail Poste
ListBox2.Clear                          'Efface Qté détail poste
TextBox2.Value = ""                     'Efface Poste
 
End Sub
 
Private Sub CommandButton4_Click()
'Bouton Terminer
 
If Not TextBox2 = "" Then                   'Si Poste vide -> message
 
MsgBox ("Veuillez valider votre poste")
 
Exit Sub
 
End If
 
Unload insertion                            'ne pas charger
 
End Sub

Citation:

Envoyé par Patrice740

Et c'est quoi, le code de cette macro ?

12/04/2020, 20h08
Patrice740

Bonjour,

N'y avait-t'il pas une macro (évènementielle) dans le module de la feuille "travail" du fichier d'origine ?

Sinon, appelles la procédure en fin de CommandButton2_Click() avant le End Sub ajoutes :
Call crea_recherche
12/04/2020, 20h29
Olivier2610

Bonjour,

Désolé mais qu'entends-tu par une macro événementielle ?

Citation:

Envoyé par Patrice740

Bonjour,

N'y avait-t'il pas une macro (évènementielle) dans le module de la feuille "travail" du fichier d'origine ?

Sinon, appelles la procédure en fin de CommandButton2_Click() avant le End Sub ajoutes :
Call crea_recherche
12/04/2020, 20h49
Philippe Tulliez
Bonjour,

Citation:

Désolé mais qu'entends-tu par une macro événementielle ?

Je te suggère la lecture de ces deux tutoriels sur le sujet
- Les évènements dans la feuille de calcul Excel
- Les évènements du module objet ThisWorkbook, dans Excel
12/04/2020, 21h05
Olivier2610
Ok merci je vais regarder.
Citation:
Envoyé par Philippe Tulliez

Bonjour,

Je te suggère la lecture de ces deux tutoriels sur le sujet

Les évènements dans la feuille de calcul Excel
Les évènements du module objet ThisWorkbook, dans Excel