Excel refuse d'éxécuter 2 fois d'affilée la macro

**bamboou9** · 28/05/2014, 15h20

Bonjour,

J'ai réalisé une macro sur Excel qui me permet de calculer des couples de valeurs et de les tracer dans un graphique. Elle fonctionne bien la première fois que je l’exécute, mais lorsque je souhaite l’exécuter une seconde fois, il "bugue" dans le sens ou il ne me met pas un message d'erreur mais ne calcule aucun couple de valeur, donc trace un graphique vide. Donc à chaque fois, je suis obligé de fermer l'excel et le ré-ouvrir pour relancer la macro. Auriez vous une idée de la cause ? Quelqu'un pourrait il essayer ce code sur son ordinateur et me dire si cela fait pareil ?

Pour cela, le nom du fichier Excel doit être : Hauteur =fonction(pas).xlsm et il doit se trouver un onglet nommé "Graphique" à l'intérieur.
Voilà le 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
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
Dim rayon_intercalaire As Double
Dim Rm As Double
Dim ep_matiere As Double
Dim Hm As Double
Dim Pas As Double
Dim H_inter As Double
Dim Pas_fixe As Double
Dim H_moyen As Double
Dim dev_cible As Double
Dim dev_calculée As Double
Dim i As Integer
Dim ligne As Integer
 
Function dev(Rm, Pas, H_moyen)
dev = (4 * WorksheetFunction.Pi * Rm / 360) * (Atn(((H_moyen - 2 * Rm) / Pas)) * (180 / WorksheetFunction.Pi) + Atn(Rm / Sqr(((Sqr(((H_moyen - 2 * Rm) * (H_moyen - 2 * Rm)) + (Pas * Pas)) * Sqr(((H_moyen - 2 * Rm) * (H_moyen - 2 * Rm)) + (Pas * Pas))) / 4) - (Rm * Rm))) * 180 / WorksheetFunction.Pi) + Sqr((H_moyen * H_moyen) - (4 * Rm * H_moyen) + (Pas * Pas))
End Function
 
 
Function dev_c(Rm, Hm, Pas_fixe)
dev_c = (4 * WorksheetFunction.Pi * Rm / 360) * (Atn(((Hm - 2 * Rm) / Pas_fixe)) * (180 / WorksheetFunction.Pi) + Atn(Rm / Sqr(((Sqr(((Hm - 2 * Rm) * (Hm - 2 * Rm)) + (Pas_fixe * Pas_fixe)) * Sqr(((Hm - 2 * Rm) * (Hm - 2 * Rm)) + (Pas_fixe * Pas_fixe))) / 4) - (Rm * Rm))) * 180 / WorksheetFunction.Pi) + Sqr((Hm * Hm) - (4 * Rm * Hm) + (Pas_fixe * Pas_fixe))
End Function
 
 
Sub hauteur_intercalaire()
 
'On supprime tous les graphiques pré-existants
Dim Graph As ChartObject
Dim objRange As Range
Dim Sh As Worksheet
Set Sh = Sheets("Graphique")
For Each Graph In Sh.ChartObjects
    Graph.Delete
Next Graph
 
'On efface le contenu des colonnes A, B, C
Workbooks("Hauteur =fonction(pas).xlsm").Sheets("Graphique").Activate
 
Range("A2", Range("A2").End(xlDown)).Select
Selection.ClearContents
Range("B2", Range("B2").End(xlDown)).Select
Selection.ClearContents
Range("C2", Range("C2").End(xlDown)).Select
Selection.ClearContents
 
Range("A1") = "Pas"
Range("B1") = "Hauteur"
Range("C1") = "Développée calculée"
 
 
'Entrée utilisateur
ep_matiere = InputBox("Entrez l'épaisseur matière en mm", "Epaisseur matiere", "", 150, 150)
 
rayon_intercalaire = InputBox("Entrez le rayon extérieur de l'intercalaire", "Rayon de l'intercalaire", "", 150, 150)
 
Pas_fixe = InputBox("Entrez le pas souhaité", " Pas pour le calcul de hauteur ", "", 150, 150)
 
H_inter = InputBox("Entrez la hauteur de votre intercalaire", " Hauteur sur plan de l'intercalaire ", "", 150, 150)
 
'Calcul intermédiaire
Rm = rayon_intercalaire - (ep_matiere / 2)
Hm = H_inter - ep_matiere
 
'Calcul développée fixée
On Error Resume Next
dev_cible = dev_c(Rm, Hm, Pas_fixe)
'If Err.Number <> 0 Then
       'MsgBox "Votre développée est incalculable (valeur négative dans la fonction)"
        'Err.Clear
'End If
 
'Affichage développée de l'intercalaire pour vérification
MsgBox ("Votre développée vaut " & dev_cible & " mm" & Chr(10) & " Vérifiez dans FEUILLE CALCUL MOLETTE TYPE LA CONCORDANCE. ")
 
 
'Ecriture des colonnes du graphique
Sheets("Graphique").Activate
i = 2
Do While Pas <= 3
    For Pas = 0.2 To 3 Step 0.01
    'MsgBox ("le Pas est " & Pas)
 
        For H_moyen = 0.5 To (H_inter + 3) Step 0.001
        'MsgBox ("H_moyen vaut " & H_moyen)
 
        dev_calculée = dev(Rm, Pas, H_moyen)
 
            'If Err.Number <> 0 Then
            'MsgBox "Erreur"
            'Err.Clear
            'End If
                 'Si la développée est trouvée
                If dev_calculée <= (dev_cible + 0.0005) And dev_calculée >= (dev_cible - 0.0005) Then
                    'MsgBox ("développée trouvée")
                    Cells(i, 1) = Pas
                    'Affichage de la Hauteur intercalaire
                    Cells(i, 2) = H_moyen + ep_matiere
                    Cells(i, 3) = dev_calculée
                    i = i + 1
                    'On quitte la boucle des hauteurs dès qu'une développée est trouvée pour éviter d'obtenir 2 hauteurs pour un même pas.
                    Exit For
                End If
 
        Next
    Next
 
Loop
 
'Tracé du graphique
MsgBox ("Tracé du graphique")
 
'Création du graphique
Set Graph = Sh.ChartObjects.Add(140, 10, 500, 300)
With Graph.Chart
    .ChartType = xlLineMarkers
    .SeriesCollection.NewSeries
    .HasTitle = True
    With .ChartTitle
        .Characters.Text = "Hauteur = f(pas)"
    End With
    With .SeriesCollection(1)
        .Values = Sh.Range("B2", Range("B2").End(xlDown))
        .XValues = Sh.Range("A2", Range("A2").End(xlDown))
    End With
End With
Set Graph = Nothing
Set Sh = Nothing
 
 
End Sub

Merci

**Kimy_Ire** · 28/05/2014, 16h44

Salut bamboou9,

Je vois plusieurs choses à changer, pour rapidité, clarté, efficacité, résolution de bugs.

Première chose à faire, enlever ça : On Error Resume Next. Ca te permettra peut-être de trouver la ligne qui pose soucis, ou la boucle dans laquelle la fonction ne passe pas en mode pas à pas.

Seconde chose, je n'ai jamais vu de "Dim" à l'extérieur d'une fonction ou d'une procédure. Si tu veux utiliser des variables globales, tu dois passer par "Public".

Dernière chose, tu utilises les "Select" et les "Activate". C'est la "moins" bonne façon d'utiliser le VBA. C'est bien au début pour faire des petites macros mais quand tu commences à utiliser des fonctions plus complexes, c'est à proscrire complètement.
Utilise les "With", les ".Range("XX")", etc... avec leurs propriétés associées. Tu y verras plus clair et ça sera moins source d'erreurs.

Ne reste plus qu'à mettre les mains dans le cambouis !

Cordialement,
Kimy

**mercatog** · 28/05/2014, 16h57

Je rejoins Kimy_Ire mais avec une petite nunance sur la déclaration en début de module. On peux faire Dim XX qui aura une porté sur toutes les procédures de ce module alors que Public YY dans un module standard aura une porté dans tous les modules du classeur.

Pour le code, il y aura un problème quand le paramètre dans Sqr est négatif. Il faudra faire une test dedans pour éviter le On error resume Next qui induit en erreur.

Sinon, pour le code, une seule fonction peut traiter les 2 cas (je crois que c'est similaire)

Code remanié

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Option Explicit
 
Sub Hauteur_Intercalaire()
Dim Ep As Double, RI As Double, Hi As Double, Rm As Double, Hm As Double, Hmoy As Double
Dim Pas As Double, PasF As Double, DvCib As Double, DvCal As Double
Dim Graph As ChartObject
Dim Sh As Worksheet
Dim i As Long
 
Set Sh = Worksheets("Graphique")
With Sh
    For Each Graph In .ChartObjects
        Graph.Delete
    Next Graph
    .UsedRange.ClearContents
    .Range("A1").Resize(, 3) = Array("Pas", "Hauteur", "Développée calculée")
 
    Ep = InputBox("Entrez l'épaisseur matière en mm", "Epaisseur matiere", "", 150, 150)
    RI = InputBox("Entrez le rayon extérieur de l'intercalaire", "Rayon de l'intercalaire", "", 150, 150)
    PasF = InputBox("Entrez le pas souhaité", " Pas pour le calcul de hauteur ", "", 150, 150)
    Hi = InputBox("Entrez la hauteur de votre intercalaire", " Hauteur sur plan de l'intercalaire ", "", 150, 150)
 
    Rm = RI - (Ep / 2)
    Hm = Hi - Ep
 
    DvCib = DEV(Rm, Hm, PasF)
 
    MsgBox "Votre développée vaut " & DvCib & " mm" & Chr(10) & " Vérifiez dans FEUILLE CALCUL MOLETTE TYPE LA CONCORDANCE."
 
    i = 2
    For Pas = 0.2 To 3 Step 0.01
        For Hmoy = 0.5 To Hi + 3 Step 0.001
            DvCal = DEV(Rm, Hmoy, Pas)
            If DvCal <= DvCib + 0.0005 And DvCal >= DvCib - 0.0005 Then
                .Cells(i, 1).Resize(, 3) = Array(Pas, Hmoy + Ep, DvCal)
                i = i + 1
                Exit For
            End If
        Next Hmoy
    Next Pas
 
    MsgBox "Tracé du graphique"
    Set Graph = .ChartObjects.Add(140, 10, 500, 300)
    With Graph.Chart
        .ChartArea.ClearContents
        .ChartType = xlLineMarkers
        .HasTitle = True
        .ChartTitle.Characters.Text = "Hauteur = f(pas)"
        .HasLegend = False
        With .SeriesCollection.NewSeries
            .Values = Sh.Range("B2").Resize(i)
            .XValues = Sh.Range("A2").Resize(i)
        End With
    End With
End With
Set Graph = Nothing
Set Sh = Nothing
End Sub
 
Private Function DEV(ByVal Rm As Double, ByVal Hm As Double, ByVal Pas As Double) As Double
Dim pPi As Double
 
pPi = WorksheetFunction.Pi
'On Error Resume Next Ici prévoit un test pour que tout ce qui est à l'intérieur de Sqr doit être positif
'Il faudra même développer la fonction en des calculs intermidiaires pour plus de visibilité
DEV = (4 * pPi * Rm / 360) * (Atn(((Hm - 2 * Rm) / Pas)) * (180 / pPi) + Atn(Rm / Sqr(((Sqr(((Hm - 2 * Rm) * (Hm - 2 * Rm)) + Pas ^ 2) * Sqr(((Hm - 2 * Rm) * (Hm - 2 * Rm)) + Pas ^ 2)) / 4) - Rm ^ 2)) * 180 / pPi) + Sqr(Hm ^ 2 - (4 * Rm * Hm) + Pas ^ 2)
End Function

**Kimy_Ire** · 28/05/2014, 17h28

Merci pour ton éclaircissement mercatog.

Envoyé par mercatog

On peux faire Dim XX qui aura une porté sur toutes les procédures de ce module alors que Public YY dans un module standard aura une porté dans tous les modules du classeur.

Cordialement,
Kimy

**mercatog** · 28/05/2014, 17h45

Une proposition avec test sur la fonction Dev

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
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
Option Explicit
 
Type Result
    Valeur As Double
    Echec As Boolean
End Type
 
Sub Hauteur_Intercalaire()
Dim RI As Double, Rm As Double, Hi As Double, Hm As Double, Hmoy As Double
Dim Ep As Double, Pas As Double, PasF As Double
Dim DvCib As Result, DvCal As Result
Dim Graph As ChartObject
Dim Sh As Worksheet
Dim i As Long
 
Set Sh = Worksheets("Graphique")
With Sh
    For Each Graph In .ChartObjects
        Graph.Delete
    Next Graph
    .UsedRange.ClearContents
    .Range("A1").Resize(, 3) = Array("Pas", "Hauteur", "Développée calculée")
 
    Ep = InputBox("Entrez l'épaisseur matière en mm", "Epaisseur matiere", "", 150, 150)
    RI = InputBox("Entrez le rayon extérieur de l'intercalaire", "Rayon de l'intercalaire", "", 150, 150)
    PasF = InputBox("Entrez le pas souhaité", " Pas pour le calcul de hauteur ", "", 150, 150)
    Hi = InputBox("Entrez la hauteur de votre intercalaire", " Hauteur sur plan de l'intercalaire ", "", 150, 150)
 
    Rm = RI - (Ep / 2)
    Hm = Hi - Ep
 
    DvCib = DEV(Rm, Hm, PasF)
 
    If Not DvCib.Echec Then
        MsgBox "Votre développée vaut " & DvCib.Valeur & " mm" & Chr(10) & " Vérifiez dans FEUILLE CALCUL MOLETTE TYPE LA CONCORDANCE."
 
        i = 1
        For Pas = 0.2 To 3 Step 0.01
            For Hmoy = 0.5 To Hi + 3 Step 0.001
                DvCal = DEV(Rm, Hmoy, Pas)
                If Not DvCal.Echec Then
                    If DvCal.Valeur <= DvCib.Valeur + 0.0005 And DvCal.Valeur >= DvCib.Valeur - 0.0005 Then
                        i = i + 1
                        .Cells(i, 1).Resize(, 3) = Array(Pas, Hmoy + Ep, DvCal.Valeur)
                        Exit For
                    End If
                End If
            Next Hmoy
        Next Pas
        If i > 1 Then
            MsgBox "Tracé du graphique"
            Set Graph = .ChartObjects.Add(140, 10, 500, 300)
            With Graph.Chart
                .ChartArea.ClearContents
                .ChartType = xlLineMarkers
                .HasTitle = True
                .ChartTitle.Characters.Text = "Hauteur = f(pas)"
                .HasLegend = False
                With .SeriesCollection.NewSeries
                    .Values = Sh.Range("B2").Resize(i)
                    .XValues = Sh.Range("A2").Resize(i)
                End With
            End With
        Else
            MsgBox "Aucune donnée"
        End If
    Else
        MsgBox "Erreur valeur Div Cible"
    End If
End With
Set Graph = Nothing
Set Sh = Nothing
End Sub
 
Private Function DEV(ByVal Rm As Double, ByVal Hm As Double, ByVal Pas As Double) As Result
Dim X As Double, Y As Double, Z As Double
Dim RPi As Double
 
X = (Hm - 2 * Rm) ^ 2 + Pas ^ 2
Y = (X / 4) - Rm ^ 2
Z = Hm ^ 2 - 4 * Rm * Hm + Pas ^ 2
 
If Y >= 0 And Z >= 0 Then
    RPi = 180 / WorksheetFunction.Pi
    DEV.Valeur = (2 * Rm / RPi) * (Atn(((Hm - 2 * Rm) / Pas)) * RPi + Atn(Rm / Sqr(Y)) * RPi) + Sqr(Z)
Else
    DEV.Echec = True
End If
End Function

A tester

**bamboou9** · 02/06/2014, 10h25

Je viens d'essayer et ça fonctionne nickel ! Merci infiniment !

Excel refuse d'éxécuter 2 fois d'affilée la macro

Macros et VBA Excel

Discussions similaires

Partager

Partager