Makro programmieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

sehr gerne!
hier die Datei, und noch meine Idee, wie ich es machen würde:
Einen Vorschlag hätte ich ja, aber ich weiss nicht wie ich das in VBA umsetzen muss, da mir das Wissen fehlt. Der Vorschlag ist folgender:
Nehmen wir z.B den Bereich =Gesamtübersicht_Projekte!$AA$43:$AJ$60 mit G4=5
ich würde das in zwei Makros aufteilen, ein Makro, welches nur einmal ausgeführt wird, sagen wir dem Makro1 und ein Makro, welches die Diagramme immer wieder ändert, je nach Wert in G4.
Zu Makro 1:
Makro1 soll bei jedem Diagramm im Datenbereich am Schluss (nach dem letzten Dollarzeichen) 16 Zeilen subtrahieren, sprich aus unserem Beispiel =Gesamtübersicht_Projekte!$AA$43:$AJ$60 wird dann =Gesamtübersicht_Projekte!$AA$43:$AJ$44
Dieses Makro wird genau einmal benutzt und dann ist es nutzlos, da nur einmal 16 Zeilen subtrahiert werden müssen.
Jetzt zu Makro 2:
Makro 2 soll dann immer am Schluss des Datenbereichs noch den Wert aus G4 addieren (in unserem Falle den Wert 5). Dies macht dann aus unserem bereits von Makro1 bearbeiteten Datenbereich =Gesamtübersicht_Projekte!$AA$43:$AJ$44 den Datenbereich =Gesamtübersicht_Projekte!$AA$43:$AJ$49.
=Gesamtübersicht_Projekte!$AA$43:$AJ$49 besteht aus =Gesamtübersicht_Projekte!$AA$43:$AJ$44 + am Schluss noch den Wert aus G4.
Ich hoffe das dies irgendwie mit einem Makro zu realisieren ist. Für deine Hilfe bin ich dir schon mal riesig dankbar!
Gruss Lukas
http://rapidshare.com/files/223915712/Test.xls.html
die Datei ist leider zu gross für den Forumserver, daher Rapidshare!

Hallo Martin,
sorry, hat etwas laenger gedauert, da ich nebenbei noch arbeiten muss.
Hier mal ein code um die Diagramme entsprechend anzupassen. Leider hat Deine Tabelle 71 Diagramme, von denen aber nur 9 sichtbar sind. Da kommt es zu diversen fehlern.
Um das komplett abzufangen braeuchte ich die komplette Tabelle, wuerde aber wohl zu weit fuehren.
Also:
Hier die Macros.
Diese bitte in das Tabellenblatt kopieren und schon sollte das laufen.
privat Sub adjust_diagrams()
'this is to set the start month for all diagrams by macro
Dim TargetSh As String, ChObj As ChartObject, ChtNo As Long, MyChart As Chart
Dim IChart As Long, NChart As Long, MonthNo As Long, Chart As ChartObject
Dim NoSeries As Long, SerName As String, SerXValues, SerValue
TargetSh = "Gesamtübersicht_Projekte"
' get the set number of month to be represented
MonthNo = 0
MonthNo = ThisWorkbook.Sheets(TargetSh).Range("G4").Value
If MonthNo > 0 And MonthNo 'just a short step to make sure...
ElseIf MonthNo > 36 Then
MsgBox "Monatsnummer in G4 zu gross." & vbCrLf & vbCrLf & "Bitte Zahl ninimum 1 und maximum 36 eingeben"
Thsiworkbook.Sheets(TargetSh).Range("G4").Select
Exit Sub
End If
nCharts = ThisWorkbook.Sheets(TargetSh).ChartObjects.Count
'loop through all charts on sheet
For IChart = 1 To nCharts
chtname = ChartObjects(IChart).Name
ChartObjects(IChart).Select
'get the series range of the chart series
Set MyChart = ThisWorkbook.Sheets(TargetSh).ChartObjects(IChart).Chart
'get number of series in chart
NoSeries = MyChart.SeriesCollection.Count
'loop through all series and set datarange
myname = MyChart.Name
With MyChart
For i = NoSeries To 1 Step -1
'MsgBox "Serien in Diagram: " & NoSeries
On Error Resume Next
tmptxt = .SeriesCollection(i).Formula
tmpname = .SeriesCollection(i).Name
SerName = Left(tmptxt, InStr(1, tmptxt, ",") - 1)
SerStart = Left(StrReverse(SerName), InStr(1, StrReverse(SerName), "$") - 1)
SerXValues = Mid(tmptxt, Len(SerName) + 2, InStr(Len(SerName) + 1, tmptxt, ",") - 2)
serendtemp = Left(StrReverse(tmptxt), Len(tmptxt) - (Len(tmptxt) - InStr(1, StrReverse(tmptxt), "$")))
serend2 = InStr(1, serendtemp, ",")
SerEnd = Mid(StrReverse(serendtemp), 2, (Len(serendtemp) - serend2 - 1))
serValTmp = Right(tmptxt, Len(tmptxt) - Len(SerName) - Len(SerXValues) - 2)
SerValue = Left(serValTmp, Len(serValTmp) - serend2)
lastrow = SerStart + MonthNo
With .SeriesCollection(i)
.Values = SerValues
.XValues = SerXValues
End With
Next i
End With
NextChart:
Next IChart
ThisWorkbook.Sheets(TargetSh).Range("G4").Select
MsgBox "Fertig. Alle Diagramme sind angepasst."
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G4")) Is Nothing Then
Call adjust_diagrams
End If
End Sub

Lass' bitte von Dir hoeren, ob so ok.
Gruss
Dirk aus Dubai (z.Z. Kuwait)

Private Sub adjust_diagrams() 'this is to set the start month for all diagrams by macro Dim TargetSh As String, ChObj As ChartObject, ChtNo As Long, MyChart As Chart Dim IChart As Long, NChart As Long, MonthNo As Long, Chart As ChartObject Dim NoSeries As Long, SerName As String, SerXValues, SerValue TargetSh = "Gesamtübersicht_Projekte" ' get the set number of month to be represented MonthNo = 0 MonthNo = ThisWorkbook.Sheets(TargetSh).Range("G4").Value If MonthNo > 0 And MonthNo 36 Then MsgBox "Monatsnummer in G4 zu gross." & vbCrLf & vbCrLf & "Bitte Zahl ninimum 1 und maximum _ 36 eingeben" Thsiworkbook.Sheets(TargetSh).Range("G4").Select Exit Sub End If nCharts = ThisWorkbook.Sheets(TargetSh).ChartObjects.Count 'loop through all charts on sheet For IChart = 1 To nCharts chtname = ChartObjects(IChart).Name ChartObjects(IChart).Select 'get the series range of the chart series Set MyChart = ThisWorkbook.Sheets(TargetSh).ChartObjects(IChart).Chart 'get number of series in chart NoSeries = MyChart.SeriesCollection.Count 'loop through all series and set datarange myname = MyChart.Name With MyChart For i = NoSeries To 1 Step -1 'MsgBox "Serien in Diagram: " & NoSeries On Error Resume Next tmptxt = .SeriesCollection(i).Formula tmpname = .SeriesCollection(i).Name SerName = Left(tmptxt, InStr(1, tmptxt, ",") - 1) SerStart = Left(StrReverse(SerName), InStr(1, StrReverse(SerName), "$") - 1) SerXValues = Mid(tmptxt, Len(SerName) + 2, InStr(Len(SerName) + 1, tmptxt, ",") - 2) serendtemp = Left(StrReverse(tmptxt), Len(tmptxt) - (Len(tmptxt) - InStr(1, StrReverse( _ tmptxt), "$"))) serend2 = InStr(1, serendtemp, ",") SerEnd = Mid(StrReverse(serendtemp), 2, (Len(serendtemp) - serend2 - 1)) serValTmp = Right(tmptxt, Len(tmptxt) - Len(SerName) - Len(SerXValues) - 2) SerValue = Left(serValTmp, Len(serValTmp) - serend2) lastrow = SerStart + MonthNo With .SeriesCollection(i) .Values = SerValues .XValues = SerXValues End With Next i End With NextChart: Next IChart ThisWorkbook.Sheets(TargetSh).Range("G4").Select MsgBox "Fertig. Alle Diagramme sind angepasst." End Sub

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread