Titel/Naam Grafiek kunnen knippen/plakken

[AntonK]

Ik ben bezig met een Macro waarbij de assen van de Grafiek die ik opstel automatisch worden aangepast.

Probleem is nu dat ik het opgestelde dien te kopieren naar talloze (kan over de 50) andere werkbladen dien te kopieren. Excel geeft een Grafiek nu een titel als Grafiek1 bv. Bij het kopieren van het gehele blad wijzigt de titel van een grafiek. Grafiek 1 wordt dan bv. Grafiek4.

Wie weet hoe ik de titel van een grafiek naar voren kan halen, dusdanig dat ik hem ook kan gebruiken in een maco. De volgende opties vallen voor mij op dit moment af (volgens mij):
* Grafiekvenster (geen mogelijkheid om de naam te knippen/plakken)
* Macro runnen om de naam te weten te komen (zie ik volgens mij slechts op een werkblad goed werken, maar mijn kennis ten aanzien van macro's is gelimiteerd)
* Toewijzen Macro (Dit werkt niet op het moment dat je een macro zelf wil opnemen)

Onderstaand de macro zoals ik die nu heb:
Dim min_scale As Long
Dim max_scale As Long

Range("A53").Select
min_scale = ActiveCell.Value
Range("A54").Select
max_scale = ActiveCell.Value

ActiveSheet.ChartObjects("Grafiek 4").Activate
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = min_scale
.MaximumScale = max_scale
End With

Range("A59").Select
min_scale = ActiveCell.Value
Range("A60").Select
max_scale = ActiveCell.Value

ActiveSheet.ChartObjects("Grafiek 3").Activate
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = min_scale
.MaximumScale = max_scale
End With

Range("A55").Select
max_scale = ActiveCell.Value

ActiveSheet.ChartObjects("Grafiek 8").Activate
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = 0
.MaximumScale = max_scale
.MajorUnit = 1000
End With

Range("A61").Select
max_scale = ActiveCell.Value

ActiveSheet.ChartObjects("Grafiek 9").Activate
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = 0
.MaximumScale = max_scale
.MajorUnit = 1000
End With

 

[Relleboer]

ActiveSheet.ChartObjects("Grafiek 4").Activate
With ActiveChart.Axes(xlValue)
.MinimumScale = Range("A53").Value
.MaximumScale = Range("A54").Value
End With

ActiveSheet.ChartObjects("Grafiek 3").Activate
With ActiveChart.Axes(xlValue)
.MinimumScale = Range("A59").Value
.MaximumScale = Range("A60").Value
End With

ActiveSheet.ChartObjects("Grafiek 8").Activate
With ActiveChart.Axes(xlValue)
.MinimumScale = 0
.MaximumScale = Range("A55").Value
.MajorUnit = 1000
End With

ActiveSheet.ChartObjects("Grafiek 9").Activate
With ActiveChart.Axes(xlValue)
.MinimumScale = 0
.MaximumScale = Range("A61").value
.MajorUnit = 1000
End With

code even iets kleiner gemaakt. helaas niet meer tijd op dit moment

 

[AntonK]

Alvast bedankt voor het korter maken van de code. Hoop dat je deze week tijd hebt om de vraag tot een goed einde te brengen. Mocht je meer willen weten, stel gerust je vraag.

 

[AntonK]

Zit inmiddels (na wat zoekwerk online en hulp van een collega) meer in deze richting, maar ik krijg het plaatje nog niet helemaal rond.


Dim chtobj As ChartObject
Dim n As Integer
n = 1

For Each chtobj In ActiveSheet.ChartObjects


If n = 1 Then
ActiveSheet.ChartObjects(2).Activate
With ActiveChart.Axes(xlValue)
.MinimumScale = Range("A53").Value
.MaximumScale = Range("A54").Value
End With
End If

If n = 2 Then
ActiveSheet.ChartObjects(1).Activate
With ActiveChart.Axes(xlValue)
.MinimumScale = Range("A59").Value
.MaximumScale = Range("A60").Value
End With
End If

If n = 3 Then
ActiveSheet.ChartObjects(3).Activate
With ActiveChart.Axes(xlValue)
.MinimumScale = 0
.MaximumScale = Range("A55").Value
.MajorUnit = 1000
End With
End If

If n = 4 Then
ActiveSheet.ChartObjects(4).Activate
With ActiveChart.Axes(xlValue)
.MinimumScale = 0
.MaximumScale = Range("A61").Value
.MajorUnit = 1000
End With
End If

n = n + 1
Next chtobj

End Sub