• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Grafiek fixeren m.b..v. VBA

Status
Niet open voor verdere reacties.
P

Pieter671

Gebruiker
Lid geworden
26 jun 2015
Berichten
100
Beste Excel vrienden,

Vraag:
Hoe kan ik het grafiekgebied van een Execl-grafiek fixeren zodat het grafiekgebied (zonder as-labels) altijd op dezelfde plaats blijft staan?

Toelichting
Als bijlage heb ik een vereenvoudigd model toegevoegd dat duidelijk mijn probleem laat zien.
Ik heb een grafiek gemaakt o.b.v. een vierkant: x-as van 0 t/m 2 met stappen van 0,1 en y-as van 0 t/m 2 met stappen van 0,1)
Daarnaast zijn er invoervelden die van invloed zijn op de grafiek wanneer de invoer parameters wijzigen.
Deze invoerparameters staan boven de grafiek.

Met een macro pas ik de labels aan, zodat aan de x-as en de y-as van de grafiek de juiste gegevens worden toegevoegd.
Deze macro start wanneer cel D2 gewijzigd wordt. Ook een button toegevoegd waarmee de macro gestart kan worden.

Het gaat om de volgende VBA-code:
Code: 
Sub Update_Grafiek()

Application.ScreenUpdating = False

Dim sn, pey, pex
Dim beneden As Double
Dim links As Double

  sn = Range("mijnGrenzen")
  pey = Range("PrimairEenheidY")
  pex = Range("PrimairEenheidX")
  
'bepalden hoogte as-waarden

Worksheets("Voorbeeld").Select

ActiveSheet.ChartObjects("Grafiek 1").Activate
ActiveChart.Axes(xlCategory).Select
beneden = ActiveChart.Axes(xlCategory).Height

ActiveSheet.ChartObjects("Grafiek 1").Activate
ActiveChart.Axes(xlValue).Select
links = ActiveChart.Axes(xlValue).Width


' aanpassen gebied Grafiek1 (tabblad "Map1")

With ActiveSheet.ChartObjects("Grafiek 1") 'Verander de naam van de grafiek naar de gegeven naam
    .Height = 500 ' hoogte v.d. grafiek
    .Width = 500 ' breedte v.d. grafiek
    .Top = 120  ' positioneren vanaf top
    .Left = 90 ' positioneren vanaf links
    
End With

ActiveSheet.ChartObjects("Grafiek 1").Activate 'Verander de naam van de grafiek naar de gegeven naam
ActiveChart.PlotArea.Select
With Selection
    .Height = 425 + beneden  ' hoogte v.h. tekengebied in de grafiek
    .Width = 425 + links  ' breedte v.h. tekengebied in de grafiek
    .Top = 10 ' positioneren vanaf top in de grafiek
    .Left = 10    ' positioneren vanaf links in de grafiek
End With

With Sheets("Voorbeeld").ChartObjects("Grafiek 1").Chart
    .Axes(xlCategory).MinimumScale = IIf(IsEmpty(sn(1, 1)), 0, sn(1, 1))
    .Axes(xlCategory).MaximumScale = IIf(IsEmpty(sn(2, 1)), 100, sn(2, 1))
    .Axes(xlValue).MinimumScale = IIf(IsEmpty(sn(1, 2)), -50, sn(1, 2))
    .Axes(xlValue).MaximumScale = IIf(IsEmpty(sn(2, 2)), 500, sn(2, 2))
End With
    
ActiveSheet.ChartObjects("Grafiek 1").Activate
ActiveChart.Axes(xlValue).Select
ActiveChart.Axes(xlValue).MajorUnit = pey
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).MajorUnit = pex

Range("D2").Select


End Sub

Probleem:
In Cel D2 staat nu een waarde van €100.000.000,-. Als ik deze met tussenstappen verlaag naar bijvoorbeeld € 1.000,- wordt de opzet van de grafiek anders. In tabblad "Afwijkingen" heb ik aangeven (rode cirkels) wat er wijzigt. De pijlen geven aan waarop het grafiek gebied gefixeerd (het raster) moet blijven. Ik vermoed dat het grafiekgebied (het binnengebied) in Excel, inclusief de as-labels is.

Heeft iemand een oplossing voor dit probleem?




Voorbeeld bestand:
Bekijk bijlage Voorbeeld grafiekgebied fixeren mbv VBA.xlsm
 
Helaas nog reacties gezien op deze vraag!

Heb ik de vraag of het probleem wel duidelijk genoeg beschreven?

Pieter
 
Jouw eigen conclusie is juist. Wat is het probleem of beter gesteld wat wil je opgelost hebben? Ik kom nooit grafieken tegen waarin in de x/y-as getallen als 20.000.000,00 staan. Dan staat er altijd een begeleidende tekst bij met iets van 'de getallen zijn x 1000'

2 cijfers achter de komma zijn, tenzij het het kleine getallen zijn <10?, vaak ook overbodig. Eenheden als € zet je er normaal gesproken ook niet in. Als de lezer van een grafiek niet weet waar het over gaat dan is de grafiek niet goed opgezet.
 
Het gaat ook niet om de grootte van het getal. Dat is puur als voorbeeld gebruikt.

Het gaat om de breedte van de as-label in relatie tot het gebied van de grafiek. De laatste wil ik graag constant houden, zodat de grafiek altijd precies op dezelfde plek blijft staan. Excel past het grafiekgebied aan als de as-label breder of smaller wordt. Zie plaatjes in tweede tabblad als voorbeeld.

Met de macro pas ik eea aan, alleen nog zondsr resultaat.
 
De breedte van een as-label kan je volgens mij niet aanpassen. Als ik je steeds alles op dezelfde plek wilt houden dan zal je de lettergrootte moeten aanpassen.

Dat kan wel maar gaat je wel wat rekenwerk kosten:d
Code: 
.TickLabels.Font.Size = [COLOR="#FF0000"]10[/COLOR] - Application.Lookup(Val(ar(3, 2)), Array(0, 10, 100, 1000, 10000, 100000, 1000000), Array([COLOR="#FF0000"]0, 0, 1, 2, 3, 4, 5[/COLOR]))

Met de rode getallen moet je maar een beetje stoeien.
Zonder allerlei selects en andere overbodige code wordt het zoiets:

Code: 
Sub VenA()
  With Sheets("Voorbeeld")
    ar = .Range("mijnGrenzen")
    With .ChartObjects("Grafiek 1")
      .Height = 500
      .Width = 500
      .Top = 120
      .Left = 90
      With .Chart
        With .Axes(xlCategory)
          .MinimumScale = IIf(IsEmpty(ar(1, 1)), 0, ar(1, 1))
          .MaximumScale = IIf(IsEmpty(ar(2, 1)), 100, ar(2, 1))
          .MajorUnit = ar(3, 1)
        End With
        With .Axes(xlValue)
          .MinimumScale = IIf(IsEmpty(ar(1, 2)), -50, ar(1, 2))
          .MaximumScale = IIf(IsEmpty(ar(2, 2)), 500, ar(2, 2))
          .MajorUnit = ar(3, 2)
          .TickLabels.Font.Size = 10 - Application.Lookup(Val(ar(3, 2)), Array(0, 10, 100, 1000, 10000, 100000, 1000000), Array(0, 0, 1, 2, 3, 4, 5))
        End With
      End With
    End With
  End With
End Sub
 
Beste VenA,

Bedankt. Met wat uitproberen lukt het. Top.

Ook bedankt voor het strakker neerzetten van de code.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan