Spalten ausblenden: Diagramme anpassen

Hallo zusammen,
ich weiß nun nicht mehr weiter und hoffe hier auf einen Tritt in die richtige Richtung :)
Im Anhang meine Datei:
https://www.herber.de/bbs/user/99838.xlsm
Und zwar werden auf "Übersicht" eine bestimmte Anzahl an Spalten (D:M) eingeblendet oder ausgeblendet; standardmäßig sind jedoch nie weniger als die Spalten D:I eingeblendet. Das funktioniert über ein Makro. (In meiner Bsp.datei funzt das igwie nicht, aber in der Originaldatei schon!)
Nun sollen die beiden Diagramme, die auf demselben Blatt gaanz oben zu sehen sind, von ihrer Größe her immer gleichmäßig über die eingeblendeten Spalten verteilt werden.
Das heißt: Sind Spalte D:I eingeblendet, sollen die Diagramme so groß sein wie in der Bsp.datei zu sehen. Sind Spalten D:M eingeblendet, sollen sie sich entsprechend GLEICHMÄßIG vergrößern. Hab ich mal als Bildchen in das Dokument eingebunden.
Es geht hier nur um die beiden kleinen Diagramme. Das untere große Diagramm geht ja immer schön mit :)
Klar, ich könnte die drei auch untereinander legen, aber das soll so nicht!!
Ich weiß gar nicht, wo ich anfangen soll. Hat jemand einen heißen Tipp für mich? Ich denke jetzt eher nicht an VBA. Ist bestimmt auf einfacherem Weg zu lösen, oder?
Viele Grüße
Esther

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) If Not (Application.Intersect(Tabelle2.[I36], Target) Is Nothing) Then Application.ScreenUpdating = False Tabelle1.[D:M].EntireColumn.Hidden = True If Target.Value > 0 Then Tabelle1.Columns("D:M").Resize(, Target.Value).EntireColumn.Hidden = False Select Case Target.Value Case 6: Breite = 297 '(603-9)/2 Case 7: Breite = 327 '663 Case 8: Breite = 357 '723 Case 9: Breite = 387 '783 Case 10: Breite = 417 '843 End Select Tabelle1.Shapes("Diagramm 1").Width = Breite Tabelle1.Shapes("Diagramm 2").Width = Breite Tabelle1.Shapes("Diagramm 2").Left = 9.75 + Breite + 9 Tabelle1.Shapes("Diagramm 2").Top = Tabelle1.Shapes("Diagramm 1").Top End If End If Application.ScreenUpdating = True End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim rg As Range On Error GoTo ErrExit Application.EnableEvents = False If Not Intersect(Target, Range("E40,K40:EX40")) Is Nothing Then Sheets("AS_aktivitätenbasiert").Range("D14:D3000").ClearContents End If If Not (Application.Intersect(NeueZeile.[E40], Target) Is Nothing) Then Application.ScreenUpdating = False NeueZeile.[K:EX].EntireColumn.Hidden = True If Target.Value > 0 Then NeueZeile.Columns("K:EU").Resize(, Target.Value).EntireColumn.Hidden = False End If Range(Cells(40, 11 + Target.Value), Cells(42, "EX")).ClearContents Application.ScreenUpdating = True End If If Not (Application.Intersect(NeueZeile.[I36], Target) Is Nothing) Then Application.ScreenUpdating = False Tabelle3.[D:M].EntireColumn.Hidden = True If Target.Value > 0 Then Tabelle3.Columns("D:M").Resize(, Target.Value).EntireColumn.Hidden = False Select Case Target.Value Case 5: Breite = 267 '(543-9)/2 Case 6: Breite = 297 '603 Case 7: Breite = 327 '663 Case 8: Breite = 357 '723 Case 9: Breite = 387 '783 Case 10: Breite = 417 '843 End Select Tabelle3.Shapes("Diagramm 1").Width = Breite Tabelle3.Shapes("Diagramm 2").Width = Breite Tabelle3.Shapes("Diagramm 2").Left = 13.5 + Breite + 9 Tabelle3.Shapes("Diagramm 2").Top = Tabelle3.Shapes("Diagramm 1").Top End If End If Application.ScreenUpdating = True ErrExit: Application.EnableEvents = True End Sub

So, da bin ich wieder ;)
Habe jetzt die Diagrammbreiten ermittelt und es passt FAST!
Was ich nicht verstehe: Das rechte Diagramm (bei mir wirklich Diagramm 6!) ragt bei 7, 8, 9 oder 10 zu weit über den "Rand" (= Spalte N) hinaus. Das wird also immer ein bisschen zu breit. Bei "6" sind beide Diagramme gleich groß (= 14,96 cm). Das linke Diagramm (= Diagramm 7) verbreitert sich so wie berechnet.
Mir fehlt leider noch das Verständnis zur Problembehebung...
Mein Makro (nur der untere Teil ist jetzt relevant):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range
On Error GoTo ErrExit
Application.EnableEvents = False
If Not Intersect(Target, Range("E40,K40:EX40")) Is Nothing Then
Sheets("AS_aktivitätenbasiert").Range("D14:D3000").ClearContents
End If
If Not (Application.Intersect(NeueZeile.[E40], Target) Is Nothing) Then
Application.ScreenUpdating = False
NeueZeile.[K:EX].EntireColumn.Hidden = True
If Target.Value > 0 Then
NeueZeile.Columns("K:EU").Resize(, Target.Value).EntireColumn.Hidden = False
End If
Range(Cells(40, 11 + Target.Value), Cells(42, "EX")).ClearContents
Application.ScreenUpdating = True
End If
If Not (Application.Intersect(NeueZeile.[I36], Target) Is Nothing) Then
Application.ScreenUpdating = False
Tabelle3.[D:M].EntireColumn.Hidden = True
If Target.Value > 0 Then
Tabelle3.Columns("D:M").Resize(, Target.Value).EntireColumn.Hidden = False
Select Case Target.Value
Case 6:  Breite = 423.935 '(856,87-9)/2
Case 7:  Breite = 461.435 '931,87
Case 8:  Breite = 498.935 '1006,87
Case 9:  Breite = 536.435 '1081,87
Case 10: Breite = 573.935 '1156,87
End Select
Tabelle3.Shapes("Diagramm 7").Width = Breite
Tabelle3.Shapes("Diagramm 7").Width = Breite
Tabelle3.Shapes("Diagramm 6").Left = 13.5 + Breite + 9
Tabelle3.Shapes("Diagramm 6").Top = Tabelle3.Shapes("Diagramm 7").Top
End If
End If
Application.ScreenUpdating = True
ErrExit:
Application.EnableEvents = True
End Sub

Vielen Dank und schöne Grüße
Esther

Beliebteste Forumthreads (12 Monate)

Spalten ausblenden: Diagramme anpassen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

56 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalten ausblenden: Diagramme anpassen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

56 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread