Balkendiagram mit Bilder Popup

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Private Sub Chart_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y _ As Long) Dim IDNum As Long Dim a As Long Dim b As Long ActiveChart.GetChartElement x, y, IDNum, a, b On Error Resume Next If IDNum = 3 Then SeriesCollection(a).Points(b).ApplyDataLabels SeriesCollection(a).Points(b).DataLabel.Text = "Ich bin Punkt " & _ b & vbLf & "Reihe " & a Else ActiveChart.ApplyDataLabels LegendKey:=False, HasLeaderLines:=False, _ ShowSeriesName:=False, ShowCategoryName:=False, ShowValue:=False, _ ShowPercentage:=False, ShowBubbleSize:=False End If On Error GoTo 0 End Sub

Hi,
verwende ein "normales" Tabellenblatt, in welches du die 4 Diagramme einbettest. Eingebettete Diagrammobjekte haben jedoch keine Ereignisse, die man wie beim Diagrammblatt auswerten kann. Deshalb muss man hier Klassenprogrammierung anwenden, um dann auf die Ereignisse der Klasse zugreifen zu können, welche die selben sind wie im Diagrammblatt. Dazu muss die Klasse zuerst initialisiert, also die Diagrammobjekte der Klasse zugewiesen werden (z.B. beim Öffnen der Arbeitsmappe durch Starten des betreffenden Makros).
Diese Verfahrensweise setzt voraus, dass das Diagrammobjekt im Tabellenblatt erst selektiert werden muss, ehe der betreffende Code ausgelöst werden kann.
Erstelle ein Klasssenmodul und benenne es clsDiagramm. Schreibe in dieses Klassenmodul folgenden Code:

Option Explicit
Public WithEvents chrDia As Chart
Private Sub chrDia_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal  _
y As Long)
Dim IDNum As Long
Dim a As Long
Dim b As Long
Dim arrXWerte()
Dim strName As String
chrDia.GetChartElement x, y, IDNum, a, b
On Error Resume Next
If IDNum = 3 Then
arrXWerte = chrDia.SeriesCollection(a).XValues
strName = arrXWerte(b)
If Not UserForm1.Visible Then
Call Show_Chart(strName)
Else
If UserForm1.Caption  strName Then _
Call Show_Chart(strName)
End If
Else
Unload UserForm1
End If
On Error GoTo 0
End Sub

dieser Code ruft die API-Funktionen für das Einfügen der betreffenden "Unter"-Diagramme in das UserForm auf (genau wie bei dem Beispiel mit dem Diagrammblatt der Code im Codemodul des Diagrammblattes).
Schreibe außerdem in ein allgemeines Modul diesen Code (zum Initialisieren der Klasse):

Option Explicit
Dim arrDiagramme() As New clsDiagramm
Sub DiaInit()
Dim chrDiagramm As ChartObject
Dim intDiagramm As Integer
intDiagramm = 1
ReDim arrDiagramme(1 To Worksheets("Tabelle2").ChartObjects.Count) ' Name des  _
Tabellenblattes anpassen!!
For Each chrDiagramm In Worksheets("Tabelle2").ChartObjects
Set arrDiagramme(intDiagramm).chrDia = chrDiagramm.Chart
intDiagramm = intDiagramm + 1
Next chrDiagramm
End Sub

und rufe dieses Makro im Wokbook_Open Ereignis auf.

Option Explicit Dim arrDiagramme() As New clsDiagramm Private Sub Workbook_SheetActivate(ByVal Sh As Object) Dim chrDiagramm As ChartObject Dim intDiagramm As Integer intDiagramm = 1 If InStr(Sh.Name, "Dashboard") > 0 And Sh.ChartObjects.Count > 0 Then ReDim arrDiagramme(1 To Sh.ChartObjects.Count) For Each chrDiagramm In Sh.ChartObjects Set arrDiagramme(intDiagramm).chrDia = chrDiagramm.Chart intDiagramm = intDiagramm + 1 Next chrDiagramm End If End Sub

Hi...
habe das alles so abändern können, wie du das gesagt hast. klappt eigentlich auch, wie ich mir das vorgestellt habe, jedoch ist ein problem, was ich vorher nicht bedacht habe.
was ist, wenn sich in meinem beispiel (mehrere Dashboard Reiter), die Automarken sich wiederholen?
z.b.: Dashboard - Europa, Dashboard - US, Dashboard - Asia, mit der jeweiligen Gesamtdarstellung für den aktuellen Monat für sämtliche Automarken.
in den jeweiligen Dashboard sind die jeweiligen Automarken vertreten, d.h: VW, Porsche, Ferrari etc etc, hier kann ich die einzelnen Graphiken doch nicht gleich benennen, so dass die richtige Graphik für das jeweilige Gebiet abgebildet wird...
gibt es hierzu einen lösungsansatz?
danke,
e-mo
hier kann ich den

Private Sub chrDia_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal _ y As Long) Dim IDNum As Long Dim a As Long Dim b As Long Dim arrXWerte() Dim strName As String chrDia.GetChartElement x, y, IDNum, a, b On Error Resume Next If IDNum = 3 Then arrXWerte = chrDia.SeriesCollection(a).XValues strName = arrXWerte(b) If Not UserForm1.Visible Then Call Show_Chart(strName) Else If UserForm1.Caption strName Then _ Call Show_Chart(strName) End If Else Unload UserForm1 End If On Error GoTo 0 End Sub

Option Explicit Public WithEvents chrDia As Chart Private Sub chrDia_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal _ y As Long) Dim IDNum As Long Dim a As Long Dim b As Long Dim arrXWerte() Dim strName As String chrDia.GetChartElement x, y, IDNum, a, b On Error Resume Next If IDNum = 3 Then arrXWerte = chrDia.SeriesCollection(a).XValues strName = arrXWerte(b) If Not UserForm1.Visible Then Call Show_Chart(ActiveSheet.Name & " " & strName) Else If UserForm1.Caption ActiveSheet.Name & " " & strName Then _ Call Show_Chart(ActiveSheet.Name & " " & strName) End If Else Unload UserForm1 End If On Error GoTo 0 End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object) Dim chrDiagramm As ChartObject Dim intDiagramm As Integer intDiagramm = 1 If InStr(Sh.Name, "DB") > 0 And Sh.ChartObjects.Count > 0 Then ReDim arrDiagramme(1 To Sh.ChartObjects.Count) For Each chrDiagramm In Sh.ChartObjects Set arrDiagramme(intDiagramm).chrDia = chrDiagramm.Chart intDiagramm = intDiagramm + 1 Next chrDiagramm End If End Sub

Beliebteste Forumthreads (12 Monate)

34
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Balkendiagram mit Bilder Popup

34 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

34
Beiträge zum Forumthread

Beiträge zu diesem Forumthread