Diagrammbereich ändern - Fehler | HERBERS Excel Forum

Sub test() Dim wks As Worksheet, wkb As Workbook Set wkb = Workbooks(ActiveWorkbook.Name) Dim oSerCol As Series Dim oSource As String Dim azaehler As Long For Each wks In wkb.Worksheets If wks.Name Like "M*" Then wks.Select wks.Range("A1").Select Dim ch As ChartObject For Each ch In wks.ChartObjects azaehler = 1 For Each oSerCol In ch.Chart.SeriesCollection oSource = oSerCol.FormulaLocal oSource = Replace(oSource, "[xyz.xlsb]", "") oSource = Replace(oSource, "MT", wks.Name) oSerCol.FormulaLocal = oSource Next oSerCol 'Diagrammname setzen ch.Name = wks.Name & "Dia" & azaehler 'weitersetzen azaehler = azaehler + 1 Next ch End If Next wks End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Steffen,
nur wenige schauen auf Deinen Rechner und sehen die Datei.
Ich möchte gerne den Fehler im Original sehen.
Ich baue keine Datei nach. Die Zeit hat schon jemand investiert.
Ein Nachbau sieht meist anders aus als das Original. Darum sollte das Original verlinkt werden.
Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten anonymisieren bzw. pseudonymisieren.
Select, Activate usw. ist in VBA zu 99,8% nicht notwendig.
Der Cursor ist kein Hund der überall rumgeführt werden muss.
Hinweise zu select usw. Hajo-Excel.de
Hinweise zu select usw. Online-Excel.de
Hinweise zu select usw. Online-Excel.de

Option Explicit
Sub test()
Dim wks As Worksheet, wkb As Workbook
Set wkb = Workbooks(ActiveWorkbook.Name)
Dim oSerCol As Series
Dim oSource As String
Dim azaehler As Long
For Each wks In wkb.Worksheets
With wks
If .Name Like "M*" Then
Dim ch As ChartObject
For Each ch In .ChartObjects
azaehler = 1
For Each oSerCol In ch.Chart.SeriesCollection
oSource = oSerCol.FormulaLocal
oSource = Replace(oSource, "[xyz.xlsb]", "")
oSource = Replace(oSource, "MT", wks.Name)
oSerCol.FormulaLocal = oSource
Next oSerCol
'Diagrammname setzen
ch.Name = .Name & "Dia" & azaehler
'weitersetzen
azaehler = azaehler + 1
Next ch
End If
End With
Next wks
End Sub

Ich gebe keinen Dank für eine Rückmeldung, da ich durch solche Beiträge nicht meine Beitragszahl erhöhen muss.
Also ich schreibe keine Beiträge mit dem Betreff "Gerne u. Danke für die Rückmeldung. o.w.T."
Rückmeldung ist ja in der Heutigen Zeit nicht üblich und die wenigen die eine Rückmeldung geben,
mögen mir das verzeihen, das kein Danke für eine Rückmeldung kommt.
Beiträge von Werner, Luc, robert und folgende lese ich nicht.

Sub DiagrammeKopieren() Dim lngDia As Long Dim wksTab As Worksheet Dim chrDia As ChartObject Dim serReihe As Series Dim strFormel As String Dim strTabelle As String For Each wksTab In ActiveWorkbook.Worksheets With wksTab If .ChartObjects.Count > 0 And .Name Like "M*" Then lngDia = 1 For Each chrDia In .ChartObjects With chrDia.Chart For Each serReihe In .SeriesCollection strTabelle = Mid(serReihe.Formula, InStr(serReihe.Formula, "[")) strTabelle = Left(strTabelle, InStr(strTabelle, "!") - 1) strFormel = Application.Substitute(serReihe.Formula, strTabelle, _ wksTab.Name) serReihe.Formula = strFormel Next serReihe .Parent.Name = "Dia" & lngDia End With lngDia = lngDia + 1 Next chrDia End If End With Next wksTab End Sub

Beliebteste Forumthreads (12 Monate)

Diagrammbereich ändern - Fehler

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread