Datenquelle auf aktuelles Blatt beziehen

Hallo zusammen.
Ich hätte eine Frage zu Diagrammen in Datenblättern.
Meine Excel Datei enthält mehrere Blätter die alle vom gründsätzlichen Aufbau her gleich sind (also alle Tabellen sehen gleich aus, natürlich mit anderen Zahlen innerhalb). In einem Blatt habe ich nun einige Diagramme erstellt und möchte diese nun in die anderen Datenblätter kopieren.
Das Problem hierbei ist allerdings, das der Bezug auf das neue Blatt nicht gesetzt wird, sondern der auf das alte Blatt beibehalten wird.
Beispiel: rechtsklick auf Diagramm Datenquelle
Hier habe ich nun meine Datenreihen die alle verknüpft sind mit: ='Blatt1'!$A$1:$B$10
Nach kopieren in das nächste Blatt bleibt mir diese Struktur erhalten, ich hätte aber gerne
='Blatt2'!$A$1:$B$10
Gibt es eine Möglichkeit den Bezug auf das Blatt dynamisch zu setzen (sonst müsste ich händisch jedes Diagramm neu anpassen) ?
Hat jemand eine andere Lösungsidee?
Vielen Dank für die Hilfe.
Mfg,
Michael

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub setGraphicReference() Dim objSh As Worksheet Dim objChrt As ChartObject, lngIndex As Long For Each objSh In ThisWorkbook.Worksheets For Each objChrt In objSh.ChartObjects With objChrt For lngIndex = 1 To .Chart.SeriesCollection.Count With .Chart.SeriesCollection(lngIndex) .Formula = Replace(.Formula, "XXX", objSh.Name) End With Next End With Next Next End Sub

Hallo Michi,
wahrscheinlich hast du die Diagramme nicht alle von Blatt1 kopiert, sondern auch von anderen Blättern.
Probiere mal diesen Code.


' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub setGraphicReference()
  Dim objSh As Worksheet
  Dim objChrt As ChartObject, lngIndex As Long
  
  
  For Each objSh In ThisWorkbook.Worksheets
    For Each objChrt In objSh.ChartObjects
      With objChrt
        For lngIndex = 1 To .Chart.SeriesCollection.Count
          With .Chart.SeriesCollection(lngIndex)
            .Formula = ReplaceREGEXP(.Formula, "('" & objSh.Name & "'!", "([a-z]+[0-9]{0,9}!")
            .Formula = ReplaceREGEXP(.Formula, ",'" & objSh.Name & "'!", ",[a-z]+[0-9]{0,9}!")
          End With
        Next
      End With
    Next
  Next
  
End Sub


Public Function ReplaceREGEXP(ByVal strText As String, strReplace As String, strPatten As String) As String
  Dim objRegExp As Object, strTmp As String
  
  Set objRegExp = CreateObject("vbscript.regexp")
  
  On Error Resume Next
  
  With objRegExp
    .Global = True
    .MultiLine = False
    .Pattern = strPatten
    .IgnoreCase = True
    strTmp = .Replace(strText, strReplace)
  End With
  
  If Len(strTmp) Then
    ReplaceREGEXP = strTmp
  Else
    ReplaceREGEXP = strText
  End If
  
  Set objRegExp = Nothing
  
End Function

« Gruß Sepp »

' ********************************************************************** ' Modul: Modul1 Typ: Allgemeines Modul ' ********************************************************************** Option Explicit Sub setGraphicReference() 'Stellt in Diagrammen den Bezug auf die eigene Tabelle Dim objSh As Worksheet Dim objChrt As ChartObject, lngIndex As Long For Each objSh In ThisWorkbook.Worksheets For Each objChrt In objSh.ChartObjects With objChrt For lngIndex = 1 To .Chart.SeriesCollection.Count With .Chart.SeriesCollection(lngIndex) .Formula = ReplaceREGEXP(.Formula, "('" & objSh.Name & "'!", "([\w\d\s']+!") .Formula = ReplaceREGEXP(.Formula, ",'" & objSh.Name & "'!", ",[\w\d\s']+!") End With Next End With Next Next End Sub Public Function ReplaceREGEXP(ByVal strText As String, strReplace As String, strPattern As String) As String Dim objRegExp As Object, strTmp As String Set objRegExp = CreateObject("vbscript.regexp") On Error Resume Next With objRegExp .Global = True .MultiLine = False .Pattern = strPattern .IgnoreCase = True strTmp = .Replace(strText, strReplace) End With If Len(strTmp) Then ReplaceREGEXP = strTmp Else ReplaceREGEXP = strText End If Set objRegExp = Nothing End Function

Beliebteste Forumthreads (12 Monate)

Datenquelle auf aktuelles Blatt beziehen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread