A voir également:
- Problème execution automatique
- Recherche automatique des chaînes ne fonctionne pas - Guide
- Message automatique thunderbird - Guide
- Logiciel de sauvegarde automatique gratuit - Guide
- Sommaire automatique word - Guide
- Gmail libellé automatique - Guide
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
9 déc. 2014 à 16:22
Bonjour,
Ben le souci.. c'est que sans voir ton code.. difficile de te répondre.
Quelqu'un aurait il une explication ?
Ben le souci.. c'est que sans voir ton code.. difficile de te répondre.
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