Grafieken met macro

[Christian Evers]

Hallo!

Ik heb een lading tabellen onder elkaar en wil daar meerdere dezelfde grafieken van maken. Nu heb ik hiervoor zelf een opzet gemaakt maar Excel wil er niet aan. Ziet er als volgt uit:

Sub Macro8()
'
' Macro8 Macro
' Macro recorded 10/1/2003 by Christian Evers
'

'
    For i = 0 To 5
    Charts.Add
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Sheets("K30 alles").Range("M[3 + (i*30)]:X[14 + (i*30)]"), _
        PlotBy:=xlColumns
    ActiveChart.Location Where:=xlLocationAsObject, Name:="K30 alles"
    With ActiveChart
        .HasTitle = False
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Richting"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Intensiteit"
    End With
    ActiveChart.HasLegend = False
    Next i
    
End Sub

Het probleem zit in de 4e regel waar ik de teller i wil gebruiken. Ik doe iets verkeerd, maar wat?

In de bijlage een voorbeeld van de data:

 

[Ingrid B]

Verander de 4e regel door:

ActiveChart.SetSourceData Source:=Sheets("K30 alles").Range( _
"M" & 3 + (i * 30) & ":X" & 14 + (i * 30)), _
PlotBy:=xlColumns

 

[Christian Evers]

Dank je, nu werkt het wel.
Alleen zet hij alle grafieken 'op elkaar'. Bestaat er een functie die de actieve grafiek 'knipt' (cut) zodat ik die kan plakken in een cel naar keuze?

ActiveChart.Cut werkt in ieder geval niet.

 

[Ingrid B]

De grafieken aan een cel koppelen lukt me niet, maar met volgende macro worden de grafieken onder elkaar geplaatst:

[COLOR=blue]Sub Macro8()
Dim i%, naam$, boven%
    [A1].Select
    boven = -100
    For i = 0 To 5
    Charts.Add
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Sheets("K30 alles").Range( _
        "M" & 3 + (i * 30) & ":X" & 14 + (i * 30)), _
        PlotBy:=xlColumns
    ActiveChart.Location Where:=xlLocationAsObject, Name:="K30 alles"
    With ActiveChart
        .HasTitle = False
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Richting"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Intensiteit"
    End With
    ActiveChart.HasLegend = False
    naam = Right(ActiveChart.Name, Len(ActiveChart.Name) - Len(ActiveSheet.Name) - 1)
    ActiveSheet.Shapes(naam).IncrementLeft -200
    ActiveSheet.Shapes(naam).IncrementTop boven
    boven = boven + 210
    Next i
End Sub[/COLOR]

 

[Christian Evers]

Dank je!

Met wat numerieke aanpassingen krijg ik ze nu mooi naast de data en onder elkaar.

 

[Christian Evers]

Nieuwe vraag

Hai!

Ik wil graag een titel boven elke grafiek. De eerste titelnaam staat in cel A3 en de overige namen steeds 30 cellen lager.

Zelf heb ik het volgende bedacht, maar het werkt natuurlijk weer eens niet.

Sub Macro10()
Dim i%, naam$, boven%
Dim varTitel As String
    boven = -100
    For i = 0 To 2
    
    [A3].Select
    ActiveCell.Offset(i * 30, 0).Select
    varTitel = ActiveCell.Text
    
    Charts.Add
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Sheets("K30 alles").Range( _
        "M" & 3 + (i * 30) & ":X" & 14 + (i * 30)), _
        PlotBy:=xlColumns
    ActiveChart.Location Where:=xlLocationAsObject, Name:="K30 alles"
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = varTitel
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Richting"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Intensiteit"
    End With
    ActiveChart.HasLegend = False
    naam = Right(ActiveChart.Name, Len(ActiveChart.Name) - Len(ActiveSheet.Name) - 1)
    ActiveSheet.Shapes(naam).IncrementLeft 595
    ActiveSheet.Shapes(naam).IncrementTop boven
    boven = boven + 383
    Next i
End Sub

De fout zit bij [A3].select
De eerste keer doet hij het nog wel maar daarna niet meer. Tips?

 

[Ingrid B]

Doordat de grafiek nog geselecteerd is krijg je een foutmelding wanneer je een cel wilt selecteren, want in een grafiek zijn geen cellen. Dit kan je oplossen door er ActiveSheet voor te zetten. Je hoeft echter de cellen niet te selecteren om de waarde te kunnen lezen. Je kan dus deze code:

    [A3].Select
    ActiveCell.Offset(i * 30, 0).Select
    varTitel = ActiveCell.Text

vervangen door

    varTitel = ActiveSheet.Cells(3 + i * 30, 1)

 

[Christian Evers]

Perfect!

Bedankt voor de uitleg.

 

[Christian Evers]

Met welke functie kan ik een vaste grootte aan een grafiek geven? Want de standaardgrootte is me net iets te groot. Ik wil dus steeds bij het creeeren van een nieuwe grafiek een kleinere grafiek krijgen.

 

[Ingrid B]

Ik weet niet of dit de gewenste grootte is, maar de getallen aanpassen laat ik aan jouw over

    ActiveSheet.Shapes(naam).Height = 100
    ActiveSheet.Shapes(naam).Width = 100

 

[Christian Evers]

Ik heb hier eerder eens een vraag gesteld waarbij ik de grafieken wilde sorteren op datum in een nieuw blad.
De titel van de grafiek is de datum. De oplossing die ik toen kreeg was als volgt:

Sub SorteerGrafiek()
Dim GrafTitel As String
Dim datumstring As Variant
Dim AantalGrafieken As Integer
Dim Counter As Integer
Dim Datum As Variant

For a = 1 To Sheets.Count
Sheets(a).Activate
If ActiveSheet.Name = "grafsort2" Then
    exists = True
Else
    
    
End If

Next a

If exists = False Then
Sheets.Add
ActiveSheet.Name = "grafsort2"
End If

Sheets("K30 alles").Activate
Counter = 0
AantalGrafieken = ActiveSheet.ChartObjects.Count

For j = 1 To 7
For i = 1 To AantalGrafieken                        'lus voor het aantal grafieken
    Sheets("K30 alles").Activate
    ActiveSheet.ChartObjects(i).Select              'selecteer grafiek
    GrafTitel = ActiveChart.ChartTitle.Text         'grafiektitel uit grafiek halen
    datumstring = Right(GrafTitel, Len(GrafTitel) - 11) 'datum uit grafiek halen
    Datum = Format(CDate(GrafTitel), "dddd")      'datum omzetten naar datum
    
    
    
    datum2 = Format(Weekday(j), "dddd")             'te controleren dag
        If Datum = datum2 Then                      'wanneer grafiek juiste dag is, dan:
            ActiveChart.ChartArea.Copy              'grafiek kopieren
            Sheets("grafsort2").Activate
            Range("B2").Select                      'eerste cel in nieuwe bereik kopieren
            ActiveCell.Offset(Counter * 22, 0).Select 'naar invoegpositie
            ActiveSheet.Paste                       'grafiek plakken
            Counter = Counter + 1                   'teller met 1 verhogen
        End If
    
Next i
Next j

    
End Sub

Ik dacht dat ik deze ook wel voor deze grafieken zou kunnen gebruiken mar dat blijkt niet te werken. Het verschil met de vorige grafieken is dat in de titel van de vorige grafieken er nog het woord 'Totalen' voor de datum stond. Misschien ligt het daaraan?

Zou mooi zijn als er iemand naar wil kijken.

 

[Ingrid B]

Verwijder volgende regel uit de macro:

datumstring = Right(GrafTitel, Len(GrafTitel) - 11)

 

[Christian Evers]

Heb ik gedaan, maar hij geeft aan dat

CDate(GrafTitel)=<Type mismatch>

Ik snap zelf erg weinig van deze syntax...

 

[Ingrid B]

Geplaatst door Christian Evers
Heb ik gedaan, maar hij geeft aan dat

CDate(GrafTitel)=

Ik snap zelf erg weinig van deze syntax...

En ik begrijp je vraag niet

De code die je hier geeft staat niet in de macro. Heb je nog andere wijzigingen aangebracht misschien?

 

[Christian Evers]

Oh sorry, een deel van mijn bericht is weggevallen zie ik nu.

Het probleem zit in de regel:

Datum = Format(CDate(GrafTitel), "dddd")

De 'debugger' zegt namelijk: CDate(GrafTitel)= Type mismatch

 

[Ingrid B]

Ik heb de macro getest in Excel 97, 2000 en XP, en het werkt bij mij in al die versies. Het document met de macro's heb ik hier bij gevoegd.

 

[Christian Evers]

Vreemd, want ik krijg hem echt niet aan de praat.
Zou je het ook eens willen proberen met dit document?

Hier staan de grafieken erbij.

Alvast enorm bedankt!

 

[Ingrid B]

Ik begrijp niet hoe je de grafieken hebt gemaakt, want als ik Macro10 draai, dan zien de grafieken en de titels ervan er anders uit. Doordat de weekdag nu mee in de titel staat werkt de macro SorteerGrafiek niet meer. Om deze terug bruikbaar te maken moeten deze regels

    datumstring = Right(GrafTitel, Len(GrafTitel) - 11)
    Datum = Format(CDate(GrafTitel), "dddd")

vervangen worden door

    datumstring = Right(GrafTitel, Len(GrafTitel) - 3)
    Datum = Format(CDate(datumstring), "dddd")

 

[Christian Evers]

Aaah!

Er is een klein kopieerfoutje in geslopen. Ik heb de grafieken met een net iets andere macro gemaakt, waarbij ik

varTitel = ActiveSheet.Cells(3 + i * 30, 1).Text

heb gebruikt.

Maar de grafieken zijn nu netjes gesorteerd! Maar misschien een vraagje voor de volgende keer, waar slaat dat getal 11 op in de regel:

datumstring = Right(GrafTitel, Len(GrafTitel) - 11)

en waarom heb je die veranderd naar 3?

Plus, ik zit nu te prutsen met het uitprinten van de grafieken. Wil graag drie grafieken op 1 pagina, maar Excel stelt automatisch in dat er maar 1 grafiek per pagina komt. Ik zal hier nu zelf nog even mee prutsen maar mocht je het antwoord weten dan hoor ik het graag.

In ieder geval al enorm bedankt tot nu toe! :thumb:

 

[Christian Evers]

Wacht, ik heb een domme fout gemaakt met dat printgebeuren. Had een grafiek geselecteerd en toen de printknop ingedrukt. Toen gaf die maar 1 grafiek per pagina.

Maar de vraag blijft gedeeltelijk overeind. Is het mogelijk om alle grafieken zodanig te positioneren dat met 1 druk op de knop alle grafieken netjes per drie op een pagina worden uitgeprint? Want op dit moment overlappen de grafieken de paginaranden.
Kan dit misschien met een page-break om de drie grafieken? En waar kan ik dat vinden?