• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Selected Chart.SeriesCollection

Zaslal/a Palooo 12.3.2014 16:40

Je mozne nejak v grafe prefarbit Point len pre tie ktore som oznacil???

tu je makro pre vsetky point v selecnutom grafe:
For Each aCollection In activeShape.Chart.SeriesCollection
For Each aPoint In aCollection.Points
aPoint.Format.Fill.ForeColor.RGB = RGB(100, 100, 100)
Next
Next

ale ani jedna vlasnost z pointu nehovori o tom ci je selecnuty alebo nie

Zaslat odpověď >

---

Strana:  « předchozí  1 2

Palooo(14.3.2014 15:27)#018312

ja uz som to vzdal :) ... nejde to ... uz som s tym stratil 2dnicitovat

lubo(18.3.2014 18:15)#018376

Chvíli jsem byl mimo.

Normální modul:

Dim pptClassObjekt As New pptClass

Sub Test()
Set pptClassObjekt.PPTEvent = Application
End Sub

Sub Konec()
Set pptClassObjekt.PPTEvent = Nothing
End Sub


class modul pptClass:

Public WithEvents PPTEvent As Application

Private Declare Function GetCursorPos Lib "user32" (lpPoint As CURSORPOS) As Long
Private Type CURSORPOS
x As Long
y As Long
End Type

Private Sub Class_Terminate()
Set PPTEvent = Nothing
End Sub

Private Sub PPTEvent_WindowSelectionChange(ByVal Sel As Selection)
Dim poziceMysi As CURSORPOS
Dim oShape As Shape
Dim oChart As Chart

Dim ElementID As Long, Arg1 As Long, Arg2 As Long

With Sel
If .Type = ppSelectionShapes Then
If .ShapeRange.Type = msoChart Then
Set oShape = .ShapeRange(1)
Set oChart = oShape.Chart

Call GetCursorPos(poziceMysi)
x = poziceMysi.x - ActiveWindow.PointsToScreenPixelsX(oShape.Left)
y = poziceMysi.y - ActiveWindow.PointsToScreenPixelsY(oShape.Top)

oChart.GetChartElement x, y, ElementID, Arg1, Arg2

If ElementID = xlSeries Then
With oChart.SeriesCollection(Arg1)
With .Points(Arg2)
.Format.Fill.ForeColor.RGB = RGB(255, 0, 50)
End With
End With
End If
.Unselect
End If
End If
End With
End Sub


Při prezentaci to ale nefunguje - výběry nejsou možné. Varianta fungující při prezentaci má docela zajímavý potenciál, ale zatím jsem to nerozchodil.citovat

Palooo(19.3.2014 8:48)#018379

oooo pokrok idem skusat :)

edit. suradnice su dobre len pri debugovani ma nenapadlo ze myska uz je niekde inde :))

- ok ale toto mne az tak nepomoze kedze to nezisti range ale len jeden object

... ale aj tak dik toto vyuzijem pri inych veciach :)citovat

lubo(20.3.2014 1:34)#018411

Jen pro úplnost. Jsou v tom obě verze, barvení při editování i při promítání.

Pro barvení při promítání:

Vybrat graf, záložka Vložit, Akce, Kliknutí myši, Spustit makro: KlikaciGraf

(Trochu jsem blbnul s Win API, nakonec to bylo celkem jednoduché, jen se musí ke každému grafu připojit makro samostatně, případně dalším makrem. Špatně se to ladí.)

Normální modul:

Dim pptClassObjekt As New pptClass

Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90

Private Declare Function GetCursorPos Lib "user32" (lpPoint As CURSORPOS) As Long
Private Type CURSORPOS
x As Long
y As Long
End Type

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long

Sub Test()
Set pptClassObjekt.PPTEvent = Application
End Sub

Sub Konec()
Set pptClassObjekt = Nothing
End Sub

Sub KlikaciGraf(oShape As Shape)
ObarvitGraf oShape
RefreshSlide
End Sub

Private Sub ObarvitGraf(oShape As Shape)
Dim poziceMysi As CURSORPOS
Dim ElementID As Long, Arg1 As Long, Arg2 As Long
Dim x As Long, y As Long
Dim aZoom As Single

Call GetCursorPos(poziceMysi)

If Application.SlideShowWindows.Count > 0 Then
aZoom = ActivePresentation.SlideShowWindow.View.Zoom / 100
x = (poziceMysi.x - oShape.Left * aZoom / pointsPerPixelX()) / aZoom
y = (poziceMysi.y - oShape.Top * aZoom / pointsPerPixelY()) / aZoom
Else
x = poziceMysi.x - ActiveWindow.PointsToScreenPixelsX(oShape.Left)
y = poziceMysi.y - ActiveWindow.PointsToScreenPixelsY(oShape.Top)
End If

oShape.Chart.GetChartElement x, y, ElementID, Arg1, Arg2

If ElementID = xlSeries Then
With oShape.Chart.SeriesCollection(Arg1)
With .Points(Arg2)
.Format.Fill.ForeColor.RGB = RGB(255, 0, 50)
End With
End With
End If
End Sub

Private Sub RefreshSlide()
Dim lSlideIndex As Long
lSlideIndex = SlideShowWindows(1).View.CurrentShowPosition
SlideShowWindows(1).View.GotoSlide lSlideIndex
End Sub

Private Function pointsPerPixelX() As Double
Dim hDC As Long
hDC = GetDC(0)
pointsPerPixelX = 72 / GetDeviceCaps(hDC, LOGPIXELSX)
ReleaseDC 0, hDC
End Function

Private Function pointsPerPixelY() As Double
Dim hDC As Long
hDC = GetDC(0)
pointsPerPixelY = 72 / GetDeviceCaps(hDC, LOGPIXELSY)
ReleaseDC 0, hDC
End Function


class modul pptClass:

Public WithEvents PPTEvent As Application

Private Sub Class_Terminate()
Set PPTEvent = Nothing
End Sub

Private Sub PPTEvent_WindowSelectionChange(ByVal Sel As Selection)
With Sel
If .Type = ppSelectionShapes Then
If .ShapeRange.Type = msoChart Then
ObarvitGraf .ShapeRange(1)
.Unselect
End If
End If
End With
End Sub
citovat

Strana:  « předchozí  1 2

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse