Problème execution automatique

Fermé
totaljim - 9 déc. 2014 à 16:17
 totaljim - 10 déc. 2014 à 10:55
Bonjour,

Je développe actuellement un programme vba qui permet de faire des graphiques, et qui pour chaques graphiques fait 5 régressions (1 linéaire et 4 polynomiales) puis récupère dans un tableau les valeurs des coefficients de régression de chaques ainsi que l'ordre correspondant !

Mon soucis réside dans le fait que lorsque j'execute mon code en mode débugage ou pas-à-pas, celui ne montre aucun problème, tout ce passe comme le code est écrit. Alors que lorsque je lance le programme en execution automatique, celui-ci ne me copie pas certaines valeurs dans un certain tableau et continue comme si c'était le cas, ce qui fausse tout le reste.

Quelqu'un aurait il une explication ?

En vous remerciant d'avance de vous pencher sur mon problème,

TotalJim

2 réponses

jordane45 Messages postés 38446 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 28 février 2025 4 737
9 déc. 2014 à 16:22
Bonjour,


Quelqu'un aurait il une explication ?

Ben le souci.. c'est que sans voir ton code.. difficile de te répondre.
0
Sub recap()
Dim montab(5) As Variant
Dim ordre
forme
Worksheets("Récapitulatif1").Select
forme
Worksheets("Récapitulatif").Select
rang3 = Worksheets("DonnéesCorrélations").UsedRange.Rows.Count

' Supprimer anciens graphs '
For Each Legraphe In Worksheets("Récapitulatif").ChartObjects
    Legraphe.Delete
Next
For Each Legraphe In Worksheets("Récapitulatif1").ChartObjects
    Legraphe.Delete
Next

' Boucle afin de faire TOUT les graph

For k = 1 To 2
i = 1
    For l = 1 To 4
        For m = 1 To 5
        
' Ajouter nouveau graph '
            ActiveSheet.Shapes.AddChart.Select
            ActiveSheet.ChartObjects(ActiveChart.Parent.Name).Name = "Graphiquecor" & i
            Range("I" & i) = i
            
' Supprimer séries déjà affichées '
            Do Until ActiveChart.SeriesCollection.Count = 0
                ActiveChart.SeriesCollection(1).Delete
            Loop
           
' Choix type de courbe '
            ActiveChart.ChartType = xlXYScatterLines
                
' Choix et ajout des séries '
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.HasTitle = True
            abscisse k, l
            ordonnée m
                
' Facteur de corrélation '
' on fait toutes les régressions '
            For ordre = 1 To 5
                If ordre = 1 Then
                    ActiveChart.SeriesCollection(1).Trendlines.Add
                    ActiveChart.SeriesCollection(1).Trendlines(ordre).Select
                    Selection.DisplayRSquared = True
                    rdeux = Right(ActiveChart.SeriesCollection(1).Trendlines(ordre).DataLabel.Text, 6)
                    MsgBox rdeux
                    montab(ordre) = rdeux
                Else
                    ActiveChart.SeriesCollection(1).Trendlines.Add
                    ActiveChart.SeriesCollection(1).Trendlines(ordre).Select
                    With Selection
                        .Type = xlPolynomial
                        .Order = ordre
                        .DisplayRSquared = True
                    End With
                    rdeux = Right(ActiveChart.SeriesCollection(1).Trendlines(ordre).DataLabel.Text, 6)
                    montab(ordre) = rdeux
                End If
            Next
            
            For jimmy = 1 To 5
            MsgBox montab(jimmy)
            Next
            
' détermine l'indice du tableau du meilleur R²'
            meilleur = 1
            For ordre = 1 To 4
                If montab(ordre) < montab(ordre + 1) Then
                    meilleur = ordre + 1
                End If
            Next
            Range("J" & i) = meilleur
            Range("K" & i) = montab(meilleur)

' Supprimer régressions inutiles '
            For ordre = 5 To meilleur + 1 Step -1
                ActiveChart.SeriesCollection(1).Trendlines(ordre).Delete
            Next ordre
            For ordre = meilleur - 1 To 1 Step -1
                ActiveChart.SeriesCollection(1).Trendlines(ordre).Delete
            Next ordre
    
            i = i + 1
        Next
    Next
    
' Trier du plus grand au plus petit '
    If k = 1 Then
        Range("I1:L20").Select
        ActiveWorkbook.Worksheets("Récapitulatif").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Récapitulatif").Sort.SortFields.Add Key:=Range( _
            "K1:K20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Récapitulatif").Sort
            .SetRange Range("I1:L20")
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
' Mise en place des graphiques '
        li = 2
        For ind = 1 To 20
            With Worksheets("Récapitulatif")
                .ChartObjects("" & Range("I" & ind).Value).Top = .Rows(li).Top
                .ChartObjects("" & Range("I" & ind).Value).Left = .Columns(1).Left
                .ChartObjects("" & Range("I" & ind).Value).Height = 165.75
                .ChartObjects("" & Range("I" & ind).Value).Width = 300
            End With
            Range("F" & li + 2) = Range("L" & ind)
            Range("F" & li + 3) = "ordre " & Range("J" & ind).Value
            Range("F" & li + 4) = "R² = " & Range("K" & ind).Value
            li = li + 13
        Next
        Range("I1:L20").Select
        Selection.Delete
    
    ElseIf k = 2 Then
        Range("I1:L20").Select
        ActiveWorkbook.Worksheets("Récapitulatif1").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Récapitulatif1").Sort.SortFields.Add Key:=Range( _
            "K1:K20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Récapitulatif").Sort
            .SetRange Range("I1:L20")
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
' Mise en place des graphiques '
        li = 2
        For ind = 1 To 20
            With Worksheets("Récapitulatif1")
                .ChartObjects("" & Range("I" & ind).Value).Top = .Rows(li).Top
                .ChartObjects("" & Range("I" & ind).Value).Left = .Columns(1).Left
                .ChartObjects("" & Range("I" & ind).Value).Height = 165.75
                .ChartObjects("" & Range("I" & ind).Value).Width = 300
            End With
            Range("F" & li + 2) = Range("L" & ind)
            Range("F" & li + 3) = "ordre " & Range("J" & ind).Value
            Range("F" & li + 4) = "R² = " & Range("K" & ind).Value
            li = li + 13
        Next
        Range("I1:L20").Select
        Selection.Delete
    
    End If

    Worksheets("Récapitulatif1").Select
Next



End Sub


Voila le module ou ca pose problème
0