Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1420to1424
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Diagramm Referenz auf neuen Tab setzen

VBA: Diagramm Referenz auf neuen Tab setzen
10.04.2015 12:04:47
fxm
Hi zusammen,
per VBA kopiere ich den gesamten Inhalt eines Tabs auf (n) neue Tabs. Die enthaltenen Diagramme übertragen sich zwar ebenfalls, allerdings bleibt die Zellreferenz immer auf dem Ursprungstab. Dies gilt auch für den Diagrammtitel der auf eine Zelle im Tab verweist.
Meine Frage ist, wie man dem Code beibringen kann, dass die Diagramme auf das neue Tab kopiert werden und sich anhand der Daten auf dem neuen Tab aufbauen. Außerdem wie man den Zellbezug des Titels auf das neue Tab setzt.
Eine Datei konnte ich leider nicht hochladen, deshalb hier der Code:
Option Explicit
Sub CreateNewTabs()
Dim rngMuster As Range, calcOld As XlCalculation, zz As Long, ss As Long
Dim Calc As XlCalculation
Calc = Application.Calculation: Beschleuniger xlCalculationManual
Set rngMuster = Sheets("MasterReport").UsedRange
With Sheets("SubsidiaryNames")
For zz = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
For ss = 1 To Sheets.Count
If Sheets(ss).Name = CStr(.Cells(zz, 1)) Then
MsgBox "Blatt '" & .Cells(zz, 1) & "' bereits vorhanden.", vbInformation
Exit For
End If
Next ss
If ss > Sheets.Count Then
Worksheets.Add after:=Sheets(Sheets.Count)
rngMuster.Copy
ActiveSheet.Paste
Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Rows.AutoFit
Columns("V:CU").Select
Selection.Columns.Group
Cells(5, 1) = .Cells(zz, 1)
ActiveSheet.Name = CStr(Cells(5, 1))
Range("A1").Select
End If
Next zz
End With
Beschleuniger Calc
End Sub
'   Accelerator (Beschleuniger) ___________Parameter: Calc-Status
'        Call:
'           Dim Calc As XlCalculation
'           Calc = Application.Calculation: Beschleuniger xlCalculationManual
'           ....Code....
'           Beschleuniger Calc
Sub Beschleuniger(Optional StatCal As Long = xlCalculationAutomatic)
With Application
.Calculation = StatCal
.ScreenUpdating = (StatCal  xlCalculationManual)
.EnableEvents = (StatCal  xlCalculationManual)
End With
End Sub

Vielen Dank vorab und
VG fxm

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Diagramm Referenz nach kopieren ändern
10.04.2015 13:13:49
NoNet
Hallo fxm,
kopiere folgenden Code in Deine Mappe (z.B. in ein neues Modul) :
Sub Diagrammbezug_Aendern()
'10.04.2015, NoNet
Dim objChartO As ChartObject, objChart As Chart, objS As Series
Dim strT As String, lngA As Long, lngP As Long
For Each objChartO In ActiveSheet.ChartObjects
Set objChart = objChartO.Chart
If objChart.HasTitle Then
If Left(objChart.ChartTitle.Formula, 1) = "=" Then
strT = objChart.ChartTitle.Formula
lngP = InStr(strT, "!")
strT = "='" & ActiveSheet.Name & "'!" & Mid(strT, lngP + 1, 255)
objChart.ChartTitle.Formula = strT
End If
End If
strT = objChart.SeriesCollection(1).Formula
lngP = InStr(strT, "!")
lngA = IIf(Mid(strT, 9, 1) = ",", 10, 9)
strT = Mid(strT, lngA, lngP - lngA + 1) '  "=SERIES(" = 8 oder 9 Zeichen
For Each objS In objChart.SeriesCollection
objS.Formula = Replace(objS.Formula, strT, "'" & ActiveSheet.Name & "'!")
Next
Next
End Sub
Ergänze nun den Aufruf des Makros am Ende Deines Kopiervorgangs im bestehenden Code (hier an dieser Stelle) :
            ' Change reference of diagram to active tab (Deletes Stacked Columns Format)
'ActiveSheet.ChartObjects("DIAGRAMM 2").Activate
'ActiveChart.SetSourceData Source:=Range("I420:P423")
'ActiveSheet.ChartObjects("DIAGRAMM 3").Activate
'ActiveChart.SetSourceData Source:=Range("C439:D444")
'ActiveSheet.ChartObjects("DIAGRAMM 4").Activate
'ActiveChart.SetSourceData Source:=Range("H439:I440")
' Select Cell
Range("A1").Select
Diagrammbezug_Aendern
End If
Next zz
Gruß und schönes WE, NoNet
Hast Du Interesse, andere Excel-Begeisterte kennenzulernen ? - Dann komme zum
Exceltreffen 15.-17.05.2015 in Dresden

http://www.exceltreffen.de/index.php?page=248
Anmeldungen sind noch bis 17.04.2015 möglich ! - Schau doch mal rein !

Anzeige
AW: VBA: Diagramm Referenz auf neuen Tab setzen
10.04.2015 13:06:11
fcs
Hallo fxm,
Meine Frage ist, wie man dem Code beibringen kann, dass .....
Indem du das komplette Mustertabellenblatt kopierst und nur Blattname und Zelleintrag änderst.
Gruß
Franz
Sub CreateNewTabs_Neu()
Dim wksMuster As Worksheet, calcOld As XlCalculation, zz As Long, ss As Long
Dim Calc As XlCalculation
Calc = Application.Calculation: Beschleuniger xlCalculationManual
Set wksMuster = Sheets("MasterReport")
With Sheets("SubsidiaryNames")
For zz = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
For ss = 1 To Sheets.Count
If Sheets(ss).Name = CStr(.Cells(zz, 1)) Then
MsgBox "Blatt '" & .Cells(zz, 1) & "' bereits vorhanden.", vbInformation
Exit For
End If
Next ss
If ss > Sheets.Count Then
wksMuster.Copy after:=Sheets(Sheets.Count)
Cells(5, 1) = .Cells(zz, 1)
ActiveSheet.Name = CStr(Cells(5, 1))
Range("A1").Select
End If
Next zz
End With
Beschleuniger Calc
End Sub

Anzeige
AW: VBA: Diagramm Referenz auf neuen Tab setzen
10.04.2015 19:05:54
fxm
Vielen vielen herzlichen Dank. Beide Codes funktionieren wunderbar.
fxm

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige