Macro Excel 2010 ne fonctionne plus sous Excel 2016

Version imprimable

25/07/2016, 12h53
leloup84

Macro Excel 2010 ne fonctionne plus sous Excel 2016

Bonjour,
J'avais une macro que fonctionnait en Excel 2010 après une combinaison de touche ctrl+m, qui ne fonctionne plus en 2016.
On me met "Erreur niveau 1". De quoi cela vient-il ?
Je peux vous faire suivre un fichier exemple qui doit être remis en forme, ainsi que la macro qui permettait de le faire, si besoin
Cordialement
25/07/2016, 13h17
joe.levrai

Bonjour,

tu es sûr que c'est une erreur propre à VBA ? ça ressemble plutôt à un message prévu par le concepteur du code, pour qualifier la survenance d'une erreur à une partie bien précise du code.

En l'état, ton fichier n'est pas nécessaire, tu peux juste nous copier le code de cette procédure pour qu'on puisse le lire

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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
Sub ExecutionProgramme()
Call MiseFormePage
Call mise_en_forme_nomenclature
Call mise_en_forme_prix_de_revient
Call groupe_niveaux_nomenclature
Call prix_sous_ensemble2
End Sub
Sub MiseFormePage()
 Dim Cellule As Range
 Dim Data As Range, Lig%, Col%
'Suppression des cellules fusionnées
'***********************************
derniereligne = ActiveSheet.UsedRange.Rows.Count
Rows("1:" & derniereligne & "").Select
Selection.UnMerge
'Suppression des lignes vides
'****************************
For lignes = Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If Rows(lignes).Find("*") Is Nothing Then Rows(lignes).Delete
Next lignes
'Mise en forme de l'entete
'**************************
Set Data = Range("B1:AL6")
Application.ScreenUpdating = False
With Data
For Lig = 1 To .Rows.Count
For Col = .Columns.Count To 1 Step -1
If .Cells(Lig, Col) = "" Then .Cells(Lig, Col).Delete Shift:=xlToLeft
Next Col
Next Lig
End With
Application.ScreenUpdating = True
'mise en forme reste des données de la ligne 7 a la fin du tableau
'******************************************************************
derniereligne = ActiveSheet.UsedRange.Rows.Count
Set Data = Range("A7:AL" & derniereligne & "")
Application.ScreenUpdating = False
With Data
For Lig = 1 To .Rows.Count
For Col = .Columns.Count To 1 Step -1
If .Cells(Lig, Col) = "" Then .Cells(Lig, Col).Delete Shift:=xlToLeft
Next Col
Next Lig
End With
Application.ScreenUpdating = True
'Mise en place des largueurs colonne et ligne
'********************************************
Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
End Sub
Sub mise_en_forme_nomenclature()
    derniereligne = ActiveSheet.UsedRange.Rows.Count
    Application.ScreenUpdating = False
'decale la première cellule vide
    For r = derniereligne To 7 Step -1 '8 avant PSB
        If IsEmpty(Cells(r, 1)) Then Cells(r, 1).Delete Shift:=xlToLeft
    Next r
'colorie selon les niveaux
    With Columns("A:A")
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="1"
        .FormatConditions(1).Interior.ColorIndex = 16
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="2"
        .FormatConditions(2).Interior.ColorIndex = 48
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="3"
        .FormatConditions(3).Interior.ColorIndex = 15
    End With
'filtre automatique
    Range("A7:I7").Font.Bold = True '8 avant PSB
    Range(CStr("A7:I" & derniereligne)).AutoFilter '8 avant PSB
'bordure
    Range(CStr("A7:J" & derniereligne)).Select '8 avant PSB
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
'largeur des colonnes
    Columns("A:A").ColumnWidth = 6
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").ColumnWidth = 10
    Columns("E:E").ColumnWidth = 6
    Columns("F:F").ColumnWidth = 6
    Columns("G:G").ColumnWidth = 10
    Columns("H:H").EntireColumn.AutoFit
'supprime 3 dernieres lignes
derniereligne = ActiveSheet.UsedRange.Rows.Count
    Rows(derniereligne).Delete
    Rows(derniereligne - 1).Delete
    Rows(derniereligne - 2).Delete
 
End Sub
 
Sub mise_en_forme_prix_de_revient()
    derniereligne = ActiveSheet.UsedRange.Rows.Count
    Application.ScreenUpdating = False
    For r = 8 To derniereligne '9 avant PSB
    'colonne option à 0 et copie montant total
        Cells(r, 11).Value = 1
        niveau = Cells(r, 1).Value
        Cells(r, 11 + niveau).FormulaR1C1 = "=RC[" & CStr(-1 - niveau) & "]*RC[" & CStr(-niveau) & "]"
    Next r
End Sub
Sub groupe_niveaux_nomenclature()
    With ActiveSheet.Outline
        .AutomaticStyles = False
        .SummaryRow = xlAbove
        .SummaryColumn = xlRight
    End With
    derniereligne = ActiveSheet.UsedRange.Rows.Count
        Application.ScreenUpdating = False
    If Cells(8, 1) <> 1 Then '9 avant PSB
    MsgBox "erreur niveau 1"
    Else
    For niveau = 1 To 3
        index1 = 0
        For r = 9 To derniereligne + 1 '10 avant PSB
            If Cells(r, 1) > niveau Then
                If index1 = 0 Then index1 = r
                    ElseIf index1 <> 0 Then
                    index2 = r - 1
                    Rows(CStr(index1 & ":" & index2)).Group
                    index1 = 0
                End If
        Next r
    Next niveau
    End If
    ActiveWindow.DisplayOutline = True
   Call mise_en_forme_prix_de_revient
    End Sub
Sub prix_sous_ensemble2()
    derniereligne = ActiveSheet.UsedRange.Rows.Count
    For niveau = 4 To 2 Step -1
        index1 = 0
        For r = 9 To derniereligne + 1 '10 avant PSB
             If Cells(r, 1) >= niveau Then
                If index1 = 0 Then index1 = r
                   ElseIf index1 <> 0 Then
                       If IsEmpty(Cells(index1 - 1, 10)) Then
                           Cells(index1 - 1, 10 + niveau).FormulaR1C1 = "=R[0]C[" & CStr(1 - niveau) & "]*sum(R[1]C[1]:R[" & CStr(r - index1) & "]C[1])"
                           Cells(index1 - 1, 10 + niveau).Font.Bold = True
                       End If
                index1 = 0
             End If
        Next r
    Next niveau
 
    With Range("L7") '8 avant PSB
        .Formula = "=SUM(R8C:R" & CStr(derniereligne) & "C)" '9 avant PSB
        .Font.Bold = True
        .Font.ColorIndex = 3
    End With
End Sub

25/07/2016, 13h27
casefayere
Bonjour,
joe a raison, c'est bien le concepteur du programme qui a introduit cette vérif, ici
Code:

1 2 3 4 .... If Cells(8, 1) <> 1 Then '9 avant PSB MsgBox "erreur niveau 1" ......
25/07/2016, 13h41
leloup84

Ok mais mes fichiers sont à l'identique.
Il n'y a pas de raison que çà coince sur cette ligne.
25/07/2016, 13h50
casefayere

ou est située ta macro principale "ExecutionProgramme" ? , dans un module ?, dans la feuille concernée, avec un bouton, ou autre ?
je pose la question car si cette macro ne se trouve pas dans la feuille, il serait déjà bon de préciser avec "With" la feuille concernée, exemple, tu commences comme ça

Code:

derniereligne = ActiveSheet.UsedRange.Rows.Count

es-tu bien sur la bonne feuille ?, ça ne résoudra pas obligatoirement ton problème mais éviteras certainement des erreurs, je n'ai pas encore analysé le reste
25/07/2016, 14h00
leloup84

Ma macro se trouve dans une feuille à part. Elle est stocké dans le dossier XLSTART de Excel.
Et l'utilisateur la lance depuis la combinaison ctrl+m
25/07/2016, 14h42
joe.levrai

La cellule A8 du fichier analysé contient bien la valeur 1 ?

Car cette erreur ne s'active que si la valeur de A8 de la feuille active est différente de 1

hélas, ce code laisse trop la place aux interprétations implicites de VBA (utilisateur de Cells(x,y) sans spécifié la propriété .Value) et aux travaux sur les objects actifs (activesheet.... des Cells(x,y) sans notion de feuille parente)... ce qui jouera tôt ou tard des tours imprévus
25/07/2016, 14h45
leloup84

Non, mais du coup c'est la ligne 9.
J'ai modifié la ligne de code

Code:

If Cells(8, 1) <> 1 Then '9 avant PSB

par

Code:

If Cells(9, 1) <> 1 Then '9 avant PSB

Mais rien de mieux. Pour en A9 j'ai bien un 1.

Sinon j'ai testé en gardant le même code d'origine, mais en supprimant la 1ère ligne du fichier Excel qui est à blanc.
Du coup la ligne 9 devient la ligne 8.
Et là aussi l'erreur apparaît, hors effectivement il y a bien un 1 en A8.
25/07/2016, 14h51
joe.levrai

Est-ce que lorsque le code tourne, la feuille active (c'est à dire la feuille affichée) du classeur actif (c'est à dire le classeur que tu vois à l'écran) est bien là où la procédure doit travailler ?

on en revient aux deux problèmes que j'ai soulevé :

- travailler sur des objets actifs c'est dangereux, si on est pas sur le bon fichier ou la bonne feuille c'est les problèmes assurés

- ne pas référencer les propriétés d'un objet : ici, comment savoir si VBA a bien pris la valeur (propriété .Value) de cette cellule ?

juste avant cette ligne de code qui pose problème, tu vas ajouter ça :

Code:

Msgbox Activesheet.Name & " " & ActiveWorkbook.Name

à l'exécution du code, tu as une fenêtre qui affichera le classeur et la feuille actifs, pour vérifier que c'est ok

ensuite, tu modifies ta ligne de test comme ça :

Code:

If Cells(8, 1).Value <> 1 Then

comme ça, on est sûr que c'est la valeur de la cellule qui est lue

d'ailleurs, en parlant de cette cellule ... Elle contient un chiffre "écrit" ou ce "1" est le résultat d'une formule Excel ?
25/07/2016, 15h20
leloup84

Ok les 2 lignes de codes ajoutés ont suffit.
Merci bien, il semblerait que çà ne lisait donc pas la bonne feuille.