VBA | For Each Loop

Status
Niet open voor verdere reacties.
M

Marissie

Gebruiker
Lid geworden
15 jun 2017
Berichten
24
Ik werk momenteel met een For Each Loop om een grafiek op te stellen op elke sheet.
Mijn code die ik momenteel gebruik werkt prima maar nu heb ik extra kolommen toegevoegd aan de pivottable welke ik niet wil verwerken in de grafiek dus wil ik graag de SourceData aanpassen naar kolom A en B maar krijg het niet voor elkaar. De grafiek blijft maar alles meenemen.

Dit is de macro dat 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 ws.range("A3:B3").End(xlDown))
.ChartColor = 11
.HasTitle = True
.ChartTitle.Caption = "Monthly Sales 2017"
.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

Misschien dat u ook weet hoe ik de ChartTitle kan noemen zoals staat aangegeven in cell B1?
 
Laatst bewerkt door een moderator:
Doe er eens een voorbeeldje bij, dat werkt wat makkelijker. En omdat je nieuw bent, weet je het waarschijnlijk nog niet, maar code kun je het beste opmaken met de CODE tag (knop #) dan blijft hij leesbaar. Zonder lachebekjes :). Maar een voorbeeldje is wel zo prettig.
 
Zo bedoel je dus OctaFish?

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 ws.Range("A3:B" & ws.Range("B" & Rows.Count).End(xlDown).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
 
Momenteel ben ik aan het kijken of ik mijn bestand als bijlage kan laten zien...een ogenblikje alsjeblieft
 
Ik heb geprobeerd het volledige bestandje mee te sturen maar dat lukt me niet op de een of andere manier, het wordt niet geaccepteerd terwijl het gewoon een macro enabled worksheet is. Maar goed...ik ben hier nieuw inderdaad dus ik moet het nog even uitvinden :)
 
Ahhh....volgens mij zit het er nu bij :)
 

Bijlagen

  • 20170608 test.pdf
    317,8 KB · Weergaven: 24
Is weer een .PDF en daar kan of wil niemand iets mee.

Plaats een Excel bestand. Het volledige document is niet nodig. Een voorbeeld is voldoende als er maar uit blijkt hoe het geheel in elkaar steekt.
 
Hahaha sorry...
Nu is het wel goed:rolleyes:
 

Bijlagen

  • 20170608 test.xlsx
    1,4 MB · Weergaven: 33
Nee hoor. Is een .xlsx en daar staat geen code in.
 
****....wauw...dit is echt ongelooflijk...niet het juiste.
Ik krijg het gewoon niet voor elkaar hoor. Ik sla het bestand op als een excel workbook en probeer het toe te voegen maar dan krijg ik steeds de melding dat het niet lukt. Kan ik het anders naar je mailen?
 
Nope, je moet save as type macro-enabled (de 2e optie van boven) doen. dan wordt het een .xlsm file. Anders wordt je VBA code niet bewaard, als het goed is krijg je ook een melding en die moet je even goed lezen of je ja of nee kiest dat is altijd heel verwarrend.
 
Dank je wel voor je reactie HellBoy. Ik had al een andere (nieuw) bericht erin gegooid want dit ging echt nergens meer over. Beetje stom van mij gister. Het nieuwe bericht bevat wel een juist voorbeeld van het bestandje en een leesbare weergave van de code dus hoop dat het hulp biedt.
 
In jouw nieuwe bericht staat een reactie en volgens mij heb je daar nog niet op gereageerd.
 
Dat klopt inderdaad. Ben net thuis en log net in op de computer om te testen en te reageren
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan