VBA | For Each Loop to create charts

Status
Niet open voor verdere reacties.
M

Marissie

Gebruiker
Lid geworden
15 jun 2017
Berichten
24
Bekijk bijlage TEST.xlsm

Een nieuwe poging:

Momenteel werk ik met bijgevoegd bestandje om via een macro een chart te creëren op elke worksheet. Momenteel neemt de chart de volledige data mee uit de pivottable maar ik wil deze slechts beperken tot kolom A en B maar wat ik ook probeer, het werkt niet. Misschien dat ik hier hulp kan vinden.

Dit is de code die ik momenteel heb:

Code: 
Sub CreateCharts()

Dim ws As Worksheet
Dim co As ChartObject

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Inhoudsopgave" Then
Set co = ws.ChartObjects.Add(300, 30, 600, 300)
    With co.Chart
    .ChartType = xlColumnClustered
    .SetSourceData Source:=ws.Range("A3:B" & ws.Range("B" & Rows.Count).End(xlUp).Row)
    .ChartColor = 11
    .HasTitle = True
    .ChartTitle.Caption = ws.Range("B1").Value
    .ChartGroups(1).VaryByCategories = True
    .ChartArea.RoundedCorners = True
    .ChartArea.Shadow = True
    End With
    
'Move chart
co.Left = ws.Range("F3").Left
co.Top = ws.Range("F3").Top
co.Width = ws.Range("F3:P3").Width
co.Height = ws.Range("F3:P22").Height

Set co = Nothing

    End If

Next ws

End Sub
 
Dan pas je toch gewoon de draaitabel aan ?

De grafiek is de grafische weergave van de draaitabel.
De grafiek verandert als de draaitabel verandert.
Daarom hoeft de grafiek maar 1 keer per blad gemaakt te worden. Als de draaitabel wijzigt, wijzigt de grafiek.

Draaitabelwijziging:

Code: 
Sub M_snb()
  On Error Resume Next
  For Each it In Sheets
      it.PivotTables(1).PivotFields("Gemiddelde").Orientation = 0
      it.PivotTables(1).PivotFields("Aantal").Orientation = 0
   Next
End Sub

Alternatieve code om grafieken te maken:

Code: 
Sub M_snb()
   For Each it In Sheets
    If it.Name <> "Inhoudsopgave" Then
     With it.ChartObjects.Add(Columns(3).Left, Rows(3).Top, Columns(16).Left - Columns(6).Left, Rows(22).Top - Rows(3).Top).Chart
        .ChartType = 51
        .SetSourceData it.PivotTables(1).TableRange1
        .HasTitle = True
        .ChartTitle.Caption = it.Range("B1").Value
        .ChartGroups(1).VaryByCategories = True
        .ChartArea.RoundedCorners = True
        .ChartArea.Shadow = True
    End With
    End If
  Next
End Sub
 
Laatst bewerkt:
Hi SNB, dank je voor je bericht. Ik heb zojuist de onderste code gekopieerd en proberen uit te voeren. Ik krijg alleen een foutmelding terug: Unable to get the PivotTables property of the Worksheet class. Nog nooit gezien, maar creeert wel een grafiek :)
Nog steeds neemt het data mee uit kolom C en D. Het liefst hou ik de draaitabel zoals het is omdat dat informatie is dat wordt gevraagd, maar als het niet anders kan dan houdt het op natuurlijk. Ik ga nu de bovenste code even uitproberen...
 
De bovenste doet niets. Moet er niet eerst iets worden gedimmed?

Ik denk dat ik maar iets anders moet verzinnen...
 
Dan heb je de code niet uitgevoerd in het bestand dat je hier hebt geplaatst.

En lees mijn commentaar nog eens goed door.
 
Het werkt inderdaad in het bestandje dat ik had toegevoegd maar dit is maar een beknopt voorbeeldje. Het echte bestand zelf was te groot ofzo. Anyway...zoals het door middel van jouw code wordt, was het ook oorspronkelijk en werkte alles perfect. Maarja, toen kreeg ik het verzoek om de aanvullende kolommen C en D eraan toe te voegen waardoor de grafiek te druk werd. Dus vandaar dat ik probeerde de macro zo op te stellen dat ik de draaitabel zo kon laten en de grafiek aan kon passen. Maar uit jouw opmerking maak ik op dat dat niet mogelijk is. En alleen door middel van draaitabellen is het mogelijk om deze vorm van rapporten te maken (denk ik) dus voorlopig ga ik inderdaad weer even terug naar het oorspronkelijke en probeer ik op een andere manier wel die aanvullende informatie weer te geven.
Maar daar ga ik me nog even in verdiepen.
 
Je kunt per werkblad 2 draaitabellen maken: 1 met de extra kolommen en 1 zonder.

Die zonder de extra kolommen gebruik je dan als basis voor de grafiek.
 
Dat zou inderdaad een goed alternatief kunnen zijn, al ben ik bang dat dat te makkelijk is.
Ik moet namelijk een wekelijks raport maken waarin de omzet van elke klant per week zichtbaar moet zijn en nu ook dus de gemiddelde waarde etc. Totaal overbodig wat mij betreft, maar dat terzijde. Wat ik tot nu toe heb gemaakt vind ik hartstikke mooi, een soort boek met inhoudsopgave waar de klanten in alfabetische volgorde staan vermeld, gehyperlinked zodat je makkelijk naar die specifieke klant kan gaan en daar weer een hyperlink terug naar de inhoudsopgave zodat je makkelijk door dat boek kan navigeren. De situatie is alleen dat wij bijna 200 klanten hebben dus om zoveel draaitabellen op te stellen is ontzettend saai en kost veel tijd.
Als je 1 "sourcetabel" maakt waarin je de klant in de filter stopt heb je via de Analyze button helemaal links onder options de keuze om te kiezen voor Show Report Filter pages. Excel maakt dan binnen enkele seconden allemaal nieuwe werkbladen aan met een draaitabel van elke klant. Ook de werkbladen zijn automatisch genoemd naar de betreffende klant in dit geval. Mooie functie alleen werkt dat helaas maar met 1 tabel. Aangezien wij dus zoveel klanten hebben is het voor mij geen optie om er handmatig een tweede draaitabel in te zetten.

Lang verhaal kort: het idee is goed maar zal helaas niet werken. Niet als ik het boek behoud zoals het nu is.

Ik kan misschien wel het boek houden zoals ik origineel had maar dan een extra werkblad met zo een totaaloverzicht waar alles in staat.
Kan een optie zijn. Misschien met slicers gaan werken al is daar het nadeel dat je geen zoekfunctie hebt. Als je bijna 200 namen in zo een slicer hebt staan wordt het ook zo rommelig

Hahaha een heel verhaal...sorry :p
Ik moet gewoon even wat uit gaan proberen en kijken wat het beste werkt.
 
De situatie is alleen dat wij bijna 200 klanten hebben dus om zoveel draaitabellen op te stellen is ontzettend saai en kost veel tijd.
Klik om te vergroten...

Dat doet toch een macro (zie mijn voorbeeld) in een flits ? en hoeft maar eenmalig gedraaid te worden.
 
Jaa...dat is een punt waar ik me nog even in moet verdiepen want de tweede tabel moet dan ook nog in een bepaalde range geplaatst worden dus ook hier werkt een for each loop waar net wat meer details voor nodig zijn.
 
Ik dacht aan:

Code: 
Sub M_snb()
    With Sheet1
        .PivotTables(1).TableRange2.Copy .Cells(20, 1)
        With .PivotTables(1)
           .PivotFields("Gemiddelde").Orientation = 0
           .PivotFields("Aantal").Orientation = 0
           Sheet1.ChartObjects(1).Chart.SetSourceData .TableRange1
        End With
    End With
End Sub
 
Hahaha wauw...wat geweldig als je daar zo goed in bent. Ik ben waarschijnlijk morgen pas in staat om het te testen dus dan komt er waarschijnlijk wel een vervolg hierop. Ik vind het echt super cool, thanx!!!
 
Hi snb,

Ik had zojuist je code uitgeprobeerd en wat het heeft gedaan is kolom a en b naar cell A20 gekopieerd en alleen op de actieve werkblad.
Wat denk ik voor mij ideaal zou zijn, als dat überhaupt mogelijk is, wanneer de aanvullende kolommen extra worden toegevoegd maar dat er een ruimte van een kolom tussen beide tabellen zit om dubbele informatie te voorkomen.
 
Ik kan geen touw aan je tekst vastknopen.

Wat mij betreft gaan we pas verder als je de geplaatste code volledig begrijpt: testen is niet voldoende.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan