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