Problème de Graphe

Bonsoir,

j'avais un code qui jusqu'à présent marchait bien et tout d'un coup me fait des siennes.

Ce code permet à l'utilisateur de saisir une fonction puis de la grapher. Mais d'un coup j'ai eu un message d'erreur de données maximales par graphique, et ce même avec la fonction y=x de 0 à 11 avec un pas de 1.

Private Sub CommandButton1_Click()
Call Graphe
End Sub
Option Explicit

Sub Graphe()
    Sheets("Graphe").Activate
      Cells.Clear

    'Supprimer le graphes précédents de la feuille
    With Feuil8.ChartObjects
        If .Count > 0 Then .Delete
    End With

    Cells.Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.599993896298105
    End With
    Columns("B:F").HorizontalAlignment = xlCenter

  Dim Fonction As String, Fonction1 As String, Derivee1 As String, Derivee2 As String
  Dim numLin As Long, x As Double
  Dim Pas As Double
  Dim BorneInf As Double
  Dim BorneSup As Double
  Dim Vide As Boolean
  Dim i As Long

    ' Entêtes de colonnes
  Range("C7").Value = "x"
  Range("D7").Value = "F(x)"
  Range("E7").Value = "F'(x)"
  Range("F7").Value = "Tangente"

    ' Saisir de l'expression de la fonction y = F(x)
    Fonction = Trim(InputBox("Donnez l'expression de la fonction F(x) =" _
       , "EXPRESSION DE LA FONCTION", "x^2"))
    If Fonction = "" Then
        Beep
        MsgBox "Expression vide!", vbCritical, "   E R R E U R !"
        Exit Sub
    End If

        'Vérification du parenthésage
    If Parenthesage(Fonction) = False Then
        MsgBox "Le parenthésage a mal été effectué !", vbCritical, "E R R E U R !"
        Exit Sub
    End If

    'Saisir le pas
    Do
        Pas = InputBox("Donnez le pas de la fonction", "PAS DE LA FONCTION", "0,5")
        If Pas <= 0 Then
            Beep
            MsgBox "Le pas doit être strictement supérieur à 0 !", vbCritical, " E R R E U R !"
        End If
    Loop While Pas <= 0

    'Saisir la borne inférieure
    BorneInf = InputBox("Donnez la borne inférieure de l'intervalle d'étude", "BORNE INFERIEURE", "-5")

    'Saisir la borne supérieure
    Do
         BorneSup = InputBox("Donnez la borne supérieure de l'intervalle d'étude", "BORNE SUPERIEURE", "5")
         If BorneSup <= BorneInf Then
            Beep
            MsgBox "La borne supérieure doit être strictement supérieure à la borne inférieure !", vbCritical, "E R R E U R !"
        End If
    Loop While BorneSup <= BorneInf

    'Vérifier s'il y a assez de valeurs
    If (BorneSup - BorneInf) / Pas < 10 Then
        Beep
        MsgBox "Il n'y a pas assez de valeures pour pouvoir effectuer le tracé !", vbCritical, "E R R E U R !"
        Exit Sub
    End If
    Fonction = Parametre(Fonction)
  ' Tabulez la fonction y = Fonction
    Fonction1 = Fonction
    Fonction1 = Replace(Fonction1, "c_pi", "pi()")
    Fonction1 = Replace(Fonction1, "c_e", "e(1)")
    Fonction1 = Replace(Fonction1, "c_r1", "sqrt(1)")
    Fonction1 = Replace(Fonction1, "c_r2", "sqrt(2)")
    Fonction1 = Replace(Fonction1, "c_r3", "sqrt(3)")
    Fonction1 = Replace(Fonction1, "EXP", "exp")
    Fonction1 = Replace(Fonction1, "LOG", "ln")
    Fonction1 = Replace(Fonction1, "COS", "cos")
    Fonction1 = Replace(Fonction1, "SIN", "sin")
    Fonction1 = Replace(Fonction1, "TG", "tan")
    Fonction1 = Replace(Fonction1, "ATG", "atan")
    Fonction1 = Replace(Fonction1, "CH", "cosh")
    Fonction1 = Replace(Fonction1, "SH", "sinh")
    Fonction1 = Replace(Fonction1, "TH", "tanh")
    Fonction1 = Replace(Fonction1, "RAC", "sqrt")
    Fonction1 = Replace(Fonction1, "ABS", "abs")
    Fonction1 = Replace(Fonction1, "ENT", "int")
    Fonction1 = Replace(Fonction1, "DIV", "quotient")
    Fonction1 = Replace(Fonction1, "MOD", "mod")
    Fonction1 = Replace(Fonction1, "MIN", "min")
    Fonction1 = Replace(Fonction1, "MAX", "max")
    Fonction1 = Replace(Fonction1, "MOY", "average")
    Fonction1 = Replace(Fonction1, "RAND()", "rand()")
    Fonction1 = Replace(Fonction1, "RAND2", "randbetween")
    'Vérifier s'il y a un a

    numLin = 9

    'Vérifier s'il y a encore des majuscules
    If Maj(Fonction1) = True Then
        MsgBox "Il y a des majuscules dans votre fonction", vbCritical, "E R R E U R !"
        Exit Sub
    End If
    Cells(9, 1).Value = "F(x)="
    Cells(9, 2).Value = Fonction1
    Cells(10, 1).Value = "x1="
    Cells(10, 2).Value = BorneInf
    Cells(11, 1).Value = "x2="
    Cells(11, 2).Value = BorneSup
    Cells(12, 1).Value = "dx="
    Cells(12, 2).Value = Pas

    For x = BorneInf To BorneSup Step Pas
    Fonction1 = Fonction

        Derivee1 = Fonction1
        Derivee1 = Replace(Derivee1, "x", "(x+0.0001)")
        Derivee2 = Fonction1
        Derivee2 = Replace(Derivee2, "x", "(x-0.0001)")
        Derivee1 = "(" & Derivee1 & "-" & Derivee2 & ")" & "/0.0002"
        Derivee1 = Replace(Derivee1, "x", "C" & numLin)
        Fonction1 = Replace(Fonction1, "x", "C" & numLin)
        'MsgBox "F'1(x) = " & Derivee1, , "T E S T"
        'MsgBox "F1(x) = " & Fonction1, , "T E S T"
        Cells(numLin, 3) = x
        Cells(numLin, 4) = Evaluate(Fonction1)
        Cells(numLin, 5) = Application.Evaluate(Derivee1)
        numLin = numLin + 1
    Next
  ' Grapher la fonction tabulée
  Tracé_Du_Graphe Range(Cells(3, 3), Cells(numLin - 1, 5)).Address

End Sub
Sub Tracé_Du_Graphe(ByVal Adr As String)
' Tracer le graphe sur la feuille
    'ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
    ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
    ActiveChart.SetSourceData Source:=Range(Adr)
End Sub
Function Parenthesage(ByVal Fonction As String) As Boolean
Dim i As Long
Dim C As Long
Dim s As String
C = 0
For i = 1 To Len(Fonction)
s = Mid(Fonction, i, 1)
If s = "(" Then
    C = C + 1
ElseIf s = ")" Then
    C = C - 1
End If
If C = 0 Then
    Parenthesage = True
Else
    Parenthesage = False
End If
Next
End Function

Function Maj(ByVal Fonction As String) As Boolean
    Dim i As Long
    Maj = False
    While i <= Len(Fonction) And Maj = False
        If Fonction <> LCase(Fonction) Then
            Maj = True
        End If
        i = i + 1
    Wend
End Function

Function Parametre(ByRef Fonction As String) As String
    Dim i As Long
    Dim nbParametres As Long
    Dim lettre As String

    nbParametres = 0
    For i = 1 To 26
        If i <> 3 And i <> 5 And i <> 9 And i <> 16 And i <> 18 And i <> 24 Then 'On ne s'occupe pas de c,e,i,p,r et x
            lettre = Chr(Asc("a") + i - 1)
            If InStr(1, Fonction, lettre, vbBinaryCompare) > 0 Then
                Fonction = Replace(Fonction, lettre, "c_" & lettre)
                Cells(nbParametres + 13, 1).Value = lettre & "="
                Cells(nbParametres + 13, 1).HorizontalAlignment = xlCenter
                Cells(nbParametres + 13, 2).Value = InputBox("Valeur de la constante " & lettre, "PARAMETRE", "2")
                Cells(nbParametres + 13, 2).HorizontalAlignment = xlCenter
                Cells(nbParametres + 13, 2).Name = "c_" & lettre
                nbParametres = nbParametres + 1
            End If
        End If
    Next
    Parametre = Fonction

End Function

Merci de votre aide car je ne sais vraiment pas d'où peut venir l'erreur