AW: Suchen und Ersetzen in Diagrammen
20.04.2007 17:53:00
ingUR
Hallo, Torsten,
bitte die nachfolgende Routine in einer Kopie der Arbeitsmappe ausführen, bevor das Ergebnis auf die endgültige Fassung übertragen wird, da bei der Untersuchung festgestellt wurde, dass es Datenserien(1) gab, deren Wertebezüge fehlerhaft sind ("#REF"") und die entsprechenden ChartObjekte gelöscht werden.
Falls dieses nicht erwünscht ist, ist die Zeile chtObj.Delete auszukommentieren oder zu entfernen. Der Hinweis für diese Fälle kann ggf. ebenso auskommentiert werden.
Die Prozedur ist in einem Standardmodulordner des VBA-Projektes in der Entwicklerumgebung abzulegen.
Der Aufruf kann aus einer beliebigen Tabelle der Mappe erfolgen [Strg][F8] :: ChgDataSeriesRef :: Ausführen.
Achtung: In der Arbeitsmappe werden ALLE Diagramme auf Tabellen, deren Tabellennamen den Bestandteil "Doku" sufweist, werden bearbeitet und jede Referenz wird durch "HP X Tab" ersetzt, wobei das X für die Ordnungszahl steht, die aus dem Tabellennamen hergeleitet wird.
Option Explicit
Sub ChgDataSeriesRef()
Dim ws As Worksheet, wsName As String
Dim chtObj As ChartObject, cht As Chart
Dim s As Integer, strF As String
For Each ws In Worksheets
ws.Activate
wsName = ws.Name
For Each chtObj In ActiveSheet.ChartObjects
If InStr(wsName, "Doku") Then wsName = Replace(wsName, "Doku", "Tab")
chtObj.Activate
With ActiveChart
strF = .SeriesCollection(1).Formula
If InStr(strF, "#REF") Then
MsgBox "Fehlerhafter Bezug im Chart (" & chtObj.Chart.Name & "): " & strF
chtObj.Delete
Else
.SeriesCollection(1).Formula = CheckWorksheetName(wsName, strF)
End If
End With
Next
Next
End Sub
Private Function CheckWorksheetName(wsName As String, strF As String) As String
Dim p1 As Integer, p2 As Integer
p1 = -1
p2 = -1
p1 = InStr(1, strF, wsName) 'Suche wsName für X-Werte
p2 = InStr(p1 + 1, strF, wsName) ' suche wsName für Y-Achse
If p2
Viel Erfolg!
Uwe