Revenir à un point précis apres end if

E

eleck

XLDnaute Nouveau
Bonjour,

Petite question sur un code

J'ai fais une macro qui me fait des graphiques suivant certaines données d'un tableau
il fait bien le premier graphique mais je n'arrive pas le faire passer au second

Sub GraphLT()
'

Dim DR As Integer
Dim DC As Integer
Dim FR As Integer
Dim FC As Integer

début = InputBox("Semaine de départ de la période ", "Question")
fin = InputBox("Semaine de fin de la période", "question")


Columns("AE:AE").Select
Selection.Find(What:=début, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
DR = ActiveCell.Row
DC = ActiveCell.Column


Columns("AE:AE").Select
Selection.Find(What:=fin, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
FR = ActiveCell.Row
FC = ActiveCell.Column

For i = 1 To 19

x = Range("ae1").Offset(0, i)

Charts.Add
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SeriesCollection(1).Values = "=Sheet2!R" & DR & "C" & DC + i & ":R" & FR & "C" & FC + i
ActiveChart.SeriesCollection(1).XValues = "=Sheet2!R" & DR & "c" & "31" & ":r" & FR & "c" & "31"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Values = "=Sheet2!R" & DR & "C" & DC & ":R" & FR & "C" & FC
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet2"
ActiveChart.HasDataTable = False



ActiveChart.ChartArea.Select

sonnom = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Name

With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = x
End With

ActiveSheet.ChartObjects(sonnom).Activate

ActiveChart.ChartTitle.Select
Selection.AutoScaleFont = False
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With

ActiveWindow.Visible = False

With ActiveChart.Axes(xlValue)
.MinimumScale = 0
.MaximumScale = 15
.MinorUnit = 1
.MajorUnit = 1
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With

ActiveSheet.ChartObjects(sonnom).Activate
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.AutoScaleFont = False
With Selection.TickLabels.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With

ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.AutoScaleFont = False
With Selection.TickLabels.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With

With Selection.Border
.Weight = 1
.LineStyle = -1
.ColorIndex = 1
.Weight = xlThin
.LineStyle = xlContinuous
End With


ActiveSheet.ChartObjects(sonnom).Activate
ActiveChart.SeriesCollection(1).Select

With Selection
.MarkerBackgroundColorIndex = 1
.MarkerForegroundColorIndex = 1
.MarkerStyle = xlDiamond
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With

ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection(2).Select

With Selection.Border
.Weight = 1
.LineStyle = -1
.ColorIndex = 1
.Weight = xlThin
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = 1
.MarkerForegroundColorIndex = 1
.MarkerStyle = xlDiamond
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With

ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 57
.Weight = xlThin
.LineStyle = xlContinuous
End With
With Selection.Interior
.ColorIndex = 2
.PatternColorIndex = 1
.Pattern = xlSolid
End With



ActiveChart.ChartArea.Select
ActiveSheet.Shapes(sonnom).ScaleWidth 0.46, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes(sonnom).ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
ActiveSheet.ChartObjects(sonnom).Activate
ActiveChart.Legend.Select
Selection.Delete
ActiveSheet.ChartObjects(sonnom).Activate
Selection.Interior.ColorIndex = xlNone

If i > 16 Then
ActiveChart.ChartArea.Select
ActiveSheet.ChartObjects(sonnom).Left = Range("A1").Offset(0, i + 5).Left
ActiveSheet.ChartObjects(sonnom).Top = Range("A1").Offset(i - 5, 0).Top

If i > 12 Then

ActiveChart.ChartArea.Select
ActiveSheet.ChartObjects(sonnom).Left = Range("A1").Offset(0, i + 4).Left
ActiveSheet.ChartObjects(sonnom).Top = Range("A1").Offset(i - 4, 0).Top

If i > 8 Then

ActiveChart.ChartArea.Select
ActiveSheet.ChartObjects(sonnom).Left = Range("A1").Offset(0, i + 3).Left
ActiveSheet.ChartObjects(sonnom).Top = Range("A1").Offset(i - 3, 0).Top

If i > 4 Then

ActiveChart.ChartArea.Select
ActiveSheet.ChartObjects(sonnom).Left = Range("A1").Offset(0, i + 2).Left
ActiveSheet.ChartObjects(sonnom).Top = Range("A1").Offset(i - 2, 0).Top

If i > 0 Then

ActiveChart.ChartArea.Select
ActiveSheet.ChartObjects(sonnom).Left = Range("A1").Offset(0, i + 1).Left
ActiveSheet.ChartObjects(sonnom).Top = Range("A1").Offset(i - 1, 0).Top


End If


Next i



ActiveWindow.Visible = False

End Sub
Cliquez pour agrandir...

en fait je voudrais surtout qu'il lise le code jusqu'au if , qu'il applique la solution adéquate et apres qu'il revienne au début pour poursuivre avec le second graphique et ainsi de suite.

Si quelqu'un a une idéee ?

Je vous remercie d'avance pour votre aide.
 
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : Revenir à un point précis apres end if

Bon jour le fil, bonjour le forum,

Même remarque que Pierrot...
Peut-être comme ça (modifications en rouge) :
Code: 
Sub GraphLT()
Dim DR As Integer
Dim DC As Integer
Dim FR As Integer
Dim FC As Integer
début = InputBox("Semaine de départ de la période ", "Question")
fin = InputBox("Semaine de fin de la période", "question")
 
Columns("AE:AE").Select
Selection.Find(What:=début, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
DR = ActiveCell.Row
DC = ActiveCell.Column
 
Columns("AE:AE").Select
Selection.Find(What:=fin, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
FR = ActiveCell.Row
FC = ActiveCell.Column
For i = 1 To 19
    x = Range("ae1").Offset(0, i)
 
    Charts.Add
    ActiveChart.ChartType = xlLineMarkers
    ActiveChart.SeriesCollection(1).Values = "=Sheet2!R" & DR & "C" & DC + i & ":R" & FR & "C" & FC + i
    ActiveChart.SeriesCollection(1).XValues = "=Sheet2!R" & DR & "c" & "31" & ":r" & FR & "c" & "31"
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(2).Values = "=Sheet2!R" & DR & "C" & DC & ":R" & FR & "C" & FC
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet2"
    ActiveChart.HasDataTable = False
 
 
 
    ActiveChart.ChartArea.Select
    sonnom = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Name
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = x
    End With
 
    ActiveSheet.ChartObjects(sonnom).Activate
    ActiveChart.ChartTitle.Select
    Selection.AutoScaleFont = False
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    ActiveWindow.Visible = False
 
    With ActiveChart.Axes(xlValue)
        .MinimumScale = 0
        .MaximumScale = 15
        .MinorUnit = 1
        .MajorUnit = 1
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
 
    ActiveSheet.ChartObjects(sonnom).Activate
    ActiveChart.Axes(xlValue).Select
    Selection.TickLabels.AutoScaleFont = False
    With Selection.TickLabels.Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 5
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
 
    ActiveChart.Axes(xlCategory).Select
    Selection.TickLabels.AutoScaleFont = False
    With Selection.TickLabels.Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 5
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    With Selection.Border
        .Weight = 1
        .LineStyle = -1
        .ColorIndex = 1
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
 
    ActiveSheet.ChartObjects(sonnom).Activate
    ActiveChart.SeriesCollection(1).Select
    With Selection
        .MarkerBackgroundColorIndex = 1
        .MarkerForegroundColorIndex = 1
        .MarkerStyle = xlDiamond
        .Smooth = False
        .MarkerSize = 5
        .Shadow = False
    End With
 
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(2).Select
    With Selection.Border
        .Weight = 1
        .LineStyle = -1
        .ColorIndex = 1
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    With Selection
        .MarkerBackgroundColorIndex = 1
        .MarkerForegroundColorIndex = 1
        .MarkerStyle = xlDiamond
        .Smooth = False
        .MarkerSize = 5
        .Shadow = False
    End With
 
    ActiveChart.PlotArea.Select
    With Selection.Border
        .ColorIndex = 57
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    With Selection.Interior
        .ColorIndex = 2
        .PatternColorIndex = 1
        .Pattern = xlSolid
    End With
 
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes(sonnom).ScaleWidth 0.46, msoFalse, msoScaleFromTopLeft
    ActiveSheet.Shapes(sonnom).ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
    ActiveSheet.ChartObjects(sonnom).Activate
    ActiveChart.Legend.Select
    Selection.Delete
    ActiveSheet.ChartObjects(sonnom).Activate
    Selection.Interior.ColorIndex = xlNone
 
 
    If i > 16 Then
        ActiveChart.ChartArea.Select
        ActiveSheet.ChartObjects(sonnom).Left = Range("A1").Offset(0, i + 5).Left
        ActiveSheet.ChartObjects(sonnom).Top = Range("A1").Offset(i - 5, 0).Top
        [COLOR=red]GoTo finir[/COLOR]
    [COLOR=red]End If[/COLOR]
 
    If i > 12 Then
        ActiveChart.ChartArea.Select
        ActiveSheet.ChartObjects(sonnom).Left = Range("A1").Offset(0, i + 4).Left
        ActiveSheet.ChartObjects(sonnom).Top = Range("A1").Offset(i - 4, 0).Top
        [COLOR=red]GoTo finir[/COLOR]
    [COLOR=red]End If[/COLOR]
 
    If i > 8 Then
        ActiveChart.ChartArea.Select
        ActiveSheet.ChartObjects(sonnom).Left = Range("A1").Offset(0, i + 3).Left
        ActiveSheet.ChartObjects(sonnom).Top = Range("A1").Offset(i - 3, 0).Top
        [COLOR=red]GoTo finir[/COLOR]
    [COLOR=red]End If[/COLOR]
 
    If i > 4 Then
        ActiveChart.ChartArea.Select
        ActiveSheet.ChartObjects(sonnom).Left = Range("A1").Offset(0, i + 2).Left
        ActiveSheet.ChartObjects(sonnom).Top = Range("A1").Offset(i - 2, 0).Top
        [COLOR=red]GoTo finir[/COLOR]
    [COLOR=red]End If[/COLOR]
 
    If i > 0 Then
        ActiveChart.ChartArea.Select
        ActiveSheet.ChartObjects(sonnom).Left = Range("A1").Offset(0, i + 1).Left
        ActiveSheet.ChartObjects(sonnom).Top = Range("A1").Offset(i - 1, 0).Top
    End If
 
[COLOR=red]finir:[/COLOR]
Next i
 
ActiveWindow.Visible = False
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Résolu(e)
XL 2021 Alimenter Listbox si colonne 3 contient un mot précis
Réponses
5
Affichages
266
Claudinedu13
C
H
  • Question
XL 2016 Mettre des titres avec une mise en forme spécifique
Réponses
1
Affichages
303
vgendron
vgendron
D
  • Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
405
crocrocro
C
halecs93
  • Résolu(e)
XL 2016 Indice n'appartient pas à la sélection : HELP !!!!
2
Réponses
21
Affichages
626
halecs93
halecs93
B
  • Question
XL 2021 Transfert tableau structuré EXCEL à un endroit précis de WORD
Réponses
8
Affichages
354
job75
job75
R
  • Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
1 K
TooFatBoy
TooFatBoy
B
  • Résolu(e)
XL 2016 Modifier ou créer une macro imprimer une sélection de zones
Réponses
5
Affichages
515
berru76
B
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
598
Kevin38
K
B
  • Question
Microsoft 365 liste à choix multiples avec contenu variable
Réponses
3
Affichages
468
BER6543
B
S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
170
souhaib ad
S

Membres actuellement en ligne

11 membres et 140 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 389
Messages
2 087 898
Membres
103 675
dernier inscrit
axona