Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ListBox
BildScreenshot zu ListBox ListBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema SpinButton
BildScreenshot zu SpinButton SpinButton-Seite mit Beispielarbeitsmappe aufrufen

X-AChse per Makro verschieben?

Betrifft: X-AChse per Makro verschieben? von: Julia
Geschrieben am: 05.10.2007 09:45:33

Hallo

habe folgende Makro Code aufgezeichnet:

Sub x_Achse_verschieben()
'
' x_Achse_verschieben Makro
' Makro am 05.10.2007 von julia aufgezeichnet
'

'
    ActiveSheet.ChartObjects("Diagramm 10").Activate
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).XValues = "=Pivot!R62C1:R81C1"
    ActiveChart.SeriesCollection(2).XValues = "=Pivot!R62C1:R81C1"
    ActiveChart.SeriesCollection(2).Values = "=Pivot!R62C3:R81C3"
End Sub



In diesem Makro hab ich den Wertebereich und die Beschriftung der x-Achse um 1 erhöht

Ich würde nun gerne 2 Buttons einbauen (+ Button, - Button)
Wenn ich auf + wird automatisch 1 Zelle mehr in der Achesnbechriftung und im Wertebereich hinzugefügt
Beim - Button abgezogen

Jemand eine Idee? wenn ich 2 Buttons nehme brauch ich auch 2 Makros oder???

  

Betrifft: AW: X-AChse per Makro verschieben? von: Herbert H.
Geschrieben am: 05.10.2007 11:37:07

hallo Julia,

füge einen "SpinButton" ein und verwende diesen Code:

Public z%

Private Sub SpinButton1_SpinUp()
Dim lz%
With ActiveSheet
    lz = .Cells(Rows.Count, 1).End(xlUp).Row
    If lz <= z Then Exit Sub
    z = z + 1
    With .ChartObjects(1).Chart
        .SeriesCollection(1).XValues = "=Pivot!R1C1:R" & z & "C1"
        .SeriesCollection(1).Values = "=Pivot!R1C2:R" & z & "C2"
    End With
End With
End Sub



Private Sub SpinButton1_SpinDown()
If z = 1 Then Exit Sub
z = z - 1
With ActiveSheet
    With .ChartObjects(1).Chart
        .SeriesCollection(1).XValues = "=Pivot!R1C1:R" & z & "C1"
        .SeriesCollection(1).Values = "=Pivot!R1C2:R" & z & "C2"
    End With
End With
End Sub



Spalten, Zeilen, Diagramm-Nr mußt du natürlich entsprechend anpassen...

gruß Herbert


  

Betrifft: AW: X-AChse per Makro verschieben? von: Julia
Geschrieben am: 05.10.2007 11:50:06

Hab das Makro eingetragen
Wenn ich dem Spinbutton dieses Makro zuweisen will findet er das Makro nicht


  

Betrifft: AW: X-AChse per Makro verschieben? von: Herbert H.
Geschrieben am: 05.10.2007 12:05:30

du mußt den SpinButton von der Steuerelement-Toolbox verwenden und
den Code ins Tabellenmodul kopieren !

gruß Herbert


  

Betrifft: AW: X-AChse per Makro verschieben? von: Julia
Geschrieben am: 05.10.2007 12:13:00

Habs jetzt gemacht aber er verzieht mir alles

meine Werte liegen hier:

=Pivot!$C$62:$C$81


Beschriftung der Rubrikachse:

=Pivot!$A$62:$A$81


Bei Spinup soll pro klich um 1 erhöht werden (bei Werte und Rubrikachse)
Also $A$82 $A$83 $A$84 usw.

Be Spindown pro klick um 1 veringert (bei Werte und Rubrikachse)
Also $A$80 $A$79 $A$78 usw.



Bei den Werten belibt =Pivot!$C$62 immer fix
Bei der Rubrikbeschriftung bleibt =Pivot!$A$62 immer fix

Es geht eigentlich immer um den hinteren Teil

Egal was ich mache er verzieht mir mein Diagramm


  

Betrifft: Den vorherigen Beitrag ignorieren, der ist richtig von: Julia
Geschrieben am: 05.10.2007 12:16:10

Habs jetzt gemacht aber er verzieht mir alles

meine Werte liegen hier:

=Pivot!$C$62:$C$81


Beschriftung der Rubrikachse:

=Pivot!$A$62:$A$81


Bei Spinup soll pro klich um 1 erhöht werden (bei Werte und Rubrikachse)
Also $C$82 $C$83 $C$84 usw. (Werte)
$A$82 $A$83 $A$84 (Rubrikachse)

Also immer synchron

Be Spindown pro klick um 1 veringert (bei Werte und Rubrikachse)
Also $C$80 $C$79 $C$78 usw. (Werte)
$A$80 $A$79 $A$78 (Rubrikachse)

Also immer synchron



Bei den Werten belibt =Pivot!$C$62 immer fix
Bei der Rubrikbeschriftung bleibt =Pivot!$A$62 immer fix

Es geht eigentlich immer um den hinteren Teil

Egal was ich mache er verzieht mir mein Diagramm


  

Betrifft: AW: Den vorherigen Beitrag ignorieren, der ist richtig von: Herbert H.
Geschrieben am: 05.10.2007 13:49:18

so funktionierts:

Private Sub SpinButton1_SpinUp()
With ActiveSheet
    If z >= 81 Then Exit Sub
    z = z + 1
    With .ChartObjects(1).Chart
        With .SeriesCollection(1)
            If z = 1 Then z = .Points.Count + 61
            .XValues = "=Pivot!R62C1:R" & z & "C1"
            .Values = "=Pivot!R62C3:R" & z & "C3"
        End With
    End With
End With
End Sub



Private Sub SpinButton1_SpinDown()
If z <> 0 And z <= 62 Then Exit Sub
z = z - 1
With ActiveSheet
    With .ChartObjects(1).Chart
        With .SeriesCollection(1)
            If z = -1 Then z = .Points.Count + 60
            .XValues = "=Pivot!R62C1:R" & z & "C1"
            .Values = "=Pivot!R62C3:R" & z & "C3"
        End With
    End With
End With
End Sub



gruß Herbert


  

Betrifft: AW: X-AChse per Makro verschieben? von: fcs
Geschrieben am: 05.10.2007 13:05:55

Hallo Julia,

das war jetzt etwas komplizierter als gedacht. Ich hab es mit einem Säulen-Diagramm probiert.
Ich hoffe die Kommentare reicgéhen um nachzuvolziehen, was da Passiert.

Gruß
Franz


Sub PlusButton()
  Call x_Achse_verschieben(1)
End Sub

Sub MinusButton()
  Call x_Achse_verschieben(-1)
End Sub

Sub x_Achse_verschieben(Verschiebung As Integer)
'
' x_Achse_verschieben Makro
' Makro am 05.10.2007 von julia aufgezeichnet
'
  Dim DiagObject As ChartObject, Diag As Chart, Reihe As Series
  Dim Zeile As Long, ZeileNeu As Long, strSuch As String, Pos1%, Pos2%, strFormel$
'
  Set DiagObject = ActiveSheet.ChartObjects(1)
'   Set DiagObject = .ChartObjects("Diagramm 10").Activate
    Set Diag = DiagObject.Chart
    With Diag
      'Formelstring für 1. Datenreihe analysieren
      'Beispielformel: "=SERIES(Pivot!R61C2,Pivot!R62C1:R70C1,Pivot!R62C2:R70C2,1)"
      Set Reihe = .SeriesCollection(1)
      strFormel = Reihe.FormulaR1C1 'Aktuelle Formel der 1. Datenreihe
      'Textstring für 1. Zelle der Datenreihe 1 ermitteln (ist gleich für alle Datenreihen)
      'Bestimmung der Position des 1. Zeichens des Bereichs für die 1. Datenzeile _
        Der Inhalt steht nach ! nach dem 1. Komma
      Pos1 = InStr(InStr(1, strFormel, ","), strFormel, "!", vbTextCompare) + 1
      Pos2 = InStr(Pos1, strFormel, ":", vbTextCompare) + 1
      strSuch = Mid(strFormel, Pos1, Pos2 - Pos1 + 1) 'Ergebnis z.B.: "R62C1:R"
      'Letzte Zeile der Datenreihe 1 ermitteln (ist gleich für alle Datenreihen)
      'Bestimmung der Position der 1. Ziffer der Nummer für die letzte Datenzeile
      'Steht in der Datenreihenformel anch dem Suchstring
      Pos1 = InStr(1, strFormel, strSuch, vbTextCompare) + Len(strSuch)
      'Bestimmung der Position der letzen Ziffer der Nummer für die letzte Datenzeile
      Pos2 = InStr(Pos1, strFormel, "C", vbTextCompare) - 1
      Zeile = Val(Mid(strFormel, Pos1, Pos2 - Pos1 + 1)) 'Aktuelle Zeilen-Nummer
      ZeileNeu = Zeile + Verschiebung 'Neue Zeilen-Nummer
      'In allen Datenreihen die Reihen-Formeln aktualisieren
      For Each Reihe In .SeriesCollection
        Reihe.FormulaR1C1 = Replace(Reihe.FormulaR1C1, ":R" & Zeile, ":R" & ZeileNeu)
      Next
    End With
End Sub




  

Betrifft: AW: X-AChse per Makro verschieben? von: Julia
Geschrieben am: 05.10.2007 13:20:10

Also ich bin echt baff

Klappt wunderbar
Vielen Dank

Kann man noch eine Msg-Box einbauen das wenn man zu weit nach hinten geht (minus) eine Meldung kommt

Also bis Zelle 62 bei minus


  

Betrifft: AW: X-AChse per Makro verschieben? von: fcs
Geschrieben am: 05.10.2007 13:59:07

Hallo Julia,

hier die Variante mit Vorgabe für die Minimum-Zeile.

Eigentlich sollte Herbert H.'s Variante auch funktionieren. Man muss die Änderung der Zeilennummern natürlich für alle Datenreihen machen,damit das Diagramm nicht verzerrt wird.

Gruß
Franz


Sub PlusButton()
  Call x_Achse_verschieben(Verschiebung:=1)
End Sub
Sub MinusButton()
  Call x_Achse_verschieben(Verschiebung:=-1, ZeileMin:=62)
End Sub
Sub x_Achse_verschieben(Verschiebung As Integer, Optional ZeileMin As Long)
'
' x_Achse_verschieben Makro
' Makro am 05.10.2007 von julia aufgezeichnet, modified by fcs
'
  Dim DiagObject As ChartObject, Diag As Chart, Reihe As Series
  Dim Zeile As Long, ZeileNeu As Long, strSuch As String, Pos1%, Pos2%, strFormel$
'
  Set DiagObject = ActiveSheet.ChartObjects(1)
'   Set DiagObject = .ChartObjects("Diagramm 10").Activate
    Set Diag = DiagObject.Chart
    With Diag
      'Formelstring für 1. Datenreihe analysieren
      'Beispielformel: "=SERIES(Pivot!R61C2,Pivot!R62C1:R70C1,Pivot!R62C2:R70C2,1)"
      Set Reihe = .SeriesCollection(1)
      strFormel = Reihe.FormulaR1C1 'Aktuelle Formel der 1. Datenreihe
      'Textstring für 1. Zelle der Datenreihe 1 ermitteln (ist gleich für alle Datenreihen)
      'Bestimmung der Position des 1. Zeichens des Bereichs für die 1. Datenzeile _
        Der Inhalt steht nach ! nach dem 1. Komma
      Pos1 = InStr(InStr(1, strFormel, ","), strFormel, "!", vbTextCompare) + 1
      Pos2 = InStr(Pos1, strFormel, ":", vbTextCompare) + 1
      strSuch = Mid(strFormel, Pos1, Pos2 - Pos1 + 1) 'Ergebnis z.B.: "R62C1:R"
      'Letzte Zeile der Datenreihe 1 ermitteln (ist gleich für alle Datenreihen)
      'Bestimmung der Position der 1. Ziffer der Nummer für die letzte Datenzeile
      'Steht in der Datenreihenformel anch dem Suchstring
      Pos1 = InStr(1, strFormel, strSuch, vbTextCompare) + Len(strSuch)
      'Bestimmung der Position der letzen Ziffer der Nummer für die letzte Datenzeile
      Pos2 = InStr(Pos1, strFormel, "C", vbTextCompare) - 1
      Zeile = Val(Mid(strFormel, Pos1, Pos2 - Pos1 + 1)) 'Aktuelle Zeilen-Nummer
      ZeileNeu = Zeile + Verschiebung 'Neue Zeilen-Nummer
      If ZeileNeu < ZeileMin Then
        MsgBox "Bei Zeile " & ZeileMin & " ist bei Minus-Button Ende der Fahnenstange!"
      Else
        'In allen Datenreihen die Reihen-Formeln aktualisieren
        For Each Reihe In .SeriesCollection
          Reihe.FormulaR1C1 = Replace(Reihe.FormulaR1C1, ":R" & Zeile, ":R" & ZeileNeu)
        Next
      End If
    End With
End Sub




  

Betrifft: AW: X-AChse per Makro verschieben? von: Julia
Geschrieben am: 05.10.2007 14:35:43

Es klappt prima

Ich versteh deine Formel überhaupt nicht, aber es geht ;)


  

Betrifft: fcs versteh die Formel nicht von: Julia
Geschrieben am: 05.10.2007 14:49:49

Es klappt prima, ich versuche es nachzuvollziehen aber irgendwie ;)

Hab einen weiteren Bereich in meiner Grafik


=DATENREIHE(Pivot!$H$61;Pivot!$A$62:$A$78;Pivot!$H$62:$H$67;1)


$H$62 bleibt immer fest


Jetzt will ich wieder 2 Buttons (plus und minus)

bei plus soll $H$67 um 1 erhöht werden

bei minus soll $H$67 um 1 veringert werden

bei minus allerdings maximal bis $H$64


ICh versuch deine Formel nachzuvollziehen ich komm aber echt nicht dahinter


  

Betrifft: AW: fcs versteh die Formel nicht von: fcs
Geschrieben am: 07.10.2007 18:25:37

Hallo Julia,

ich hatte zwar schon versucht durch Kommentare im Code die Funktion verständlich zu machen. Dies ist scheinbar nur teileweise gelungen.

Um den Daten-Bereich des Diagramms per Plus-Minus-Buttons zu ändern hab ich den Formeltext im Makro analysiert, um die aktuell letzte Zeile des Diagramms hereauszubekommen.

Üblicherweise sind die Zeilen für die X-Werte (X-Values) und die Y-Werte (Values) der Datenreihen in einem Diagram identisch und müssen auch parallel für alle Reihen geändert werden, wenn man nicht irgendwelchen Datensalat im Diagramm dargestellt bekommen möchte.

Die Formel für die Datenreihe sieht bei einem Säulendiagramm standardmäßig so aus:

Deutsch in A1-Darstellung:
=DATENREIHE(Pivot!$B$61;Tabelle2!$A$62:$A$70;Pivot!$B$62:$B$70;1)
Englisch unter VBA in Zeile-Spalten-Darstellung:
=SERIES(Pivot!R61C2,Pivot!R62C1:R70C1,Pivot!R62C2:R70C2,1)
oder alemein formuliert:
=SERIES(Name_Reihe,X-Werte_Reihe,Y-Werte_Reihe,Nr_Reihe)


Ziel der 1. Aktionen der Prozedur ist es den Wert für die letzte Zeile herauszubekommen.
Ich hatte mich hier für das Suchen im Formeltext entschieden. Herbert ist in seiner Lösung den Weg über die Anzahl der Datenpunkte gegangen, was evtl. die etwas elegantere Lösung ist.

Die Zeilennummer beginnt im Formeltext für die X-Werte_Reihe nach "R62C1:R". Da ich meine Prozedur auf verschiedene Diagramme anwenden wollte, hab ich die Berechnung dieses Suchstrings variabel gemacht.

    Pos1 = InStr(InStr(1, strFormel, ","), strFormel, "!", vbTextCompare) + 1

ermittelt im Formeltext ab dem 1. Zeichen die Position des "!" nach dem Komma "," und addiert 1. Hier steht das "R" der 1. Zelle des X-Werte Bereichs

    Pos2 = InStr(Pos1, strFormel, ":", vbTextCompare) + 1

ermittelt im Formeltext ab Pos1 die Position des ":" und addiert 1. Hier steht das "R" der letzten Zelle des X-Werte Bereichs
Mit den beiden Position wird dann mit der Mid-FUnktion der Suchstring berechnet.
Mit diesem Suchstring wird dann im nächsten Schritt die Position der 1. Ziffer in der Zeilennummer ermittelt; das ist die nach dem Suchstring. Danach dann die Position der letzten Ziffer der Zeilennummer; ist dann vor dem nachfolgenden "C".
Mit den ermittelten Positionen wird die Zeilen-Nummer bestimmt.
Zum Schluss wird dann für alle Datenreihen in der Formel der Textstring ":R" & Zeile durch ":R" & ZeileNeu ersetzt. Da dieser sowohl im X-Werte_Bereich als Auch im Y-Werte_Bereich vorkommt wird er auch in beiden Bereichen ersetzt..

Und als ich diese Zeilen schreibe, merke ich, dass ich viel zu kompliziert gedacht hatte.

Mein Code läßt sich vereinfachen, wobei das anzupassenden Diagramm gleich als Parameter übergeben wird, woduch das ganze noch flexibler wird, und wird zu dem nachfolgenden Code.

Dein aktuelles Problem mit dem anderen Diagramm bzw. der anderen Datenreihe im Diagramm und der Änderung des Y-Werte-Bereichs für die Datenreihe(n) läßt sich mit mit meinem Code nicht lösen. Das erfordert eine Variante. Diese findest du im Anschluss.

Gruß
Franz

Sub PlusButton()
  Call x_Achse_verschieben(Verschiebung:=1, Diagramm:=ActiveSheet.ChartObjects(1).Chart)
End Sub

Sub MinusButton()
  Call x_Achse_verschieben(Verschiebung:=-1, Diagramm:=ActiveSheet.ChartObjects(1).Chart, _
      ZeileMin:=62)
End Sub
Sub x_Achse_verschieben(Verschiebung As Integer, Diagramm As Chart, Optional ZeileMin As Long)
'
' x_Achse_verschieben Makro
' Makro am 05.10.2007 von julia aufgezeichnet, modified by fcs
'
  Dim Reihe As Series
  Dim Zeile As Long, ZeileNeu As Long, strSuch As String, Pos1%, Pos2%, strFormel$
'
  With Diagramm
    'Formelstring für 1. Datenreihe analysieren
    'Beispielformel: "=SERIES(Pivot!R61C2,Pivot!R62C1:R70C1,Pivot!R62C2:R70C2,1)"
    Set Reihe = .SeriesCollection(1)
    strFormel = Reihe.FormulaR1C1 'Aktuelle Formel der 1. Datenreihe
    'Bestimmung der Position der 1. Ziffer der Nummer der letzen Zeile des Datenbereichs _
      Diese steht nach dem 1. Komma 2 Zeichen hinter dem ":"
    Pos1 = InStr(InStr(1, strFormel, ","), strFormel, ":", vbTextCompare) + 2
    'Bestimmung der Position der letzen Ziffer der Nummer für die letzte Datenzeile _
      Diese steht vor dem nächsten "C"
    Pos2 = InStr(Pos1, strFormel, "C", vbTextCompare) - 1
    'Text mit Zeilennumer aus dem Formel-Text ausschneiden und in Zahl umwandeln
    Zeile = Val(Mid(strFormel, Pos1, Pos2 - Pos1 + 1)) 'Aktuelle Zeilen-Nummer
    ZeileNeu = Zeile + Verschiebung 'Neue Zeilen-Nummer
    If ZeileNeu < ZeileMin Then
      MsgBox "Bei Zeile " & ZeileMin & " ist bei Minus-Button Ende der Fahnenstange!"
    Else
      'In allen Datenreihen die Reihen-Formeln aktualisieren
      For Each Reihe In .SeriesCollection
        Reihe.FormulaR1C1 = Application.WorksheetFunction.Substitute(Reihe.FormulaR1C1, _
          ":R" & Zeile, ":R" & ZeileNeu) 'Formel ab Excel97
        'Reihe.FormulaR1C1 = Replace(Reihe.FormulaR1C1, ":R" & Zeile, ":R" & ZeileNeu) _
          'Formel für neuere Excelversionen
      Next
    End If
  End With
End Sub




  
Sub PlusButton_2()
  Call Y_Werte_verschieben(Verschiebung:=1, Diagramm:=ActiveSheet.ChartObjects(1).Chart, _
    Datenreihe:=1)
End Sub

Sub MinusButton_2()
  Call Y_Werte_verschieben(Verschiebung:=-1, Diagramm:=ActiveSheet.ChartObjects(1).Chart, _
      Datenreihe:=1, ZeileMin:=64)
End Sub

Sub Y_Werte_verschieben(Verschiebung As Integer, Diagramm As Chart, _
    Optional Datenreihe As Byte = 0, _
    Optional ZeileMin As Long)
'
' Y-Werte-Reihe verschieben Makro
' Datenreihe: Wenn Wert =0, dann werden alle Datenreihen angepasst, sonnst nur die angegebene  _
Nr
'
  Dim Reihe As Series
  Dim Zeile As Long, ZeileNeu As Long, strSuch As String, Pos1%, Pos2%, strFormel$
'
  With Diagramm
    'Formelstring für 1. Datenreihe analysieren
    'Beispielformel: "=SERIES(Pivot!R61C2,Pivot!R62C1:R70C1,Pivot!R62C2:R70C2,1)"
    Set Reihe = .SeriesCollection(IIf(Datenreihe = 0, 1, Datenreihe))
    strFormel = Reihe.FormulaR1C1 'Aktuelle Formel der 1. Datenreihe
    'Bestimmung der Position der 1. Ziffer der Nummer der letzen Zeile des Y-Datenbereichs _
      Diese steht 2 Zeichen hinter dem 2. ":"
    'Posiion des 1. Doppelpunkts (nach dem 1. Komma)
    Pos1 = InStr(InStr(1, strFormel, ","), strFormel, ":", vbTextCompare)
    'position der Ziffer nach dem 2. ":"
    Pos1 = InStr(Pos1 + 1, strFormel, ":", vbTextCompare) + 2
    'Bestimmung der Position der letzen Ziffer der Nummer für die letzte Datenzeile _
      Diese steht vor dem nächsten "C"
    Pos2 = InStr(Pos1, strFormel, "C", vbTextCompare) - 1
    'Text mit Zeilennumer aus dem Formel-Text ausschneiden und in Zahl umwandeln
    Zeile = Val(Mid(strFormel, Pos1, Pos2 - Pos1 + 1)) 'Aktuelle Zeilen-Nummer
    ZeileNeu = Zeile + Verschiebung 'Neue Zeilen-Nummer
    If ZeileNeu < ZeileMin Then
      MsgBox "Bei Zeile " & ZeileMin & " ist bei Minus-Button Ende der Fahnenstange!"
    Else
      If Datenreihe = 0 Then
        'In allen Datenreihen die Reihen-Formeln aktualisieren
        For Each Reihe In .SeriesCollection
          'Formel ab Excel97 bei neueren Excelversion ggf. auch Replace möglich
          Reihe.FormulaR1C1 = Application.WorksheetFunction.Substitute(Reihe.FormulaR1C1, _
            ":R" & Zeile, ":R" & ZeileNeu, IIf(InStr(1, strFormel, ":R" & Zeile) < Pos1 - 4, 2,  _
1))
        Next
      Else
        'Einzelne Datenreihe anpassen
        'Formel ab Excel97 bei neueren Excelversion ggf. auch Replace möglich
        Reihe.FormulaR1C1 = Application.WorksheetFunction.Substitute(Reihe.FormulaR1C1, _
          ":R" & Zeile, ":R" & ZeileNeu, IIf(InStr(1, strFormel, ":R" & Zeile) < Pos1 - 4, 2, 1) _
)
      End If
    End If
  End With
End Sub




  

Betrifft: AW: fcs versteh die Formel nicht von: Julia
Geschrieben am: 08.10.2007 09:37:47

Einfach Weltklasse

Vielen Dank!!


 

Beiträge aus den Excel-Beispielen zum Thema "X-AChse per Makro verschieben?"