Farbenie grafu v PowerPoint pomocou makra [Archív]

Farbenie grafu v PowerPoint pomocou makra

Palo235

03.03.10,10:55

Ahoj poradaci

- makro funguje dokonale
- ale chcel by som tam este doplnit jednu vec
- do databazy dat *CSOB* ( napr. "bubu(CSOB)" alebo "CSOB - mama" atd.) existuje nejaky zapis aby som nemusel vypisovat *?
- makro, priloha

za vyriesenie tohto problemu vopred dakujem .)

Sub Macro1()
'
' Makro zaznamenané 3. 3. 2010 uživatelem Vavrek
'

Set objMSGraph = ActiveWindow.Selection.ShapeRange.OLEFormat.Object .Application
Set objDatasheet = objMSGraph.Application.DataSheet
Set objchart = objMSGraph.Chart

y = objchart.SeriesCollection(1).Points.Count
z = objchart.SeriesCollection.Count

Select Case z
Case 2
z = 1
Case 4
z = 1
End Select

For i = 1 To y
x = objDatasheet.Cells(1, i + 1).Value

Select Case x
Case "VUB banka", "VÚB", "VÚB banka", "VUB"
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = 1
Case "Slovenska sporitelna", "SLSP", "Slovenská sporiteľňa"
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = 2
Case "Tatra banka", "TB"
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = 3
Case "CSOB", "ČSOB"
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = 4
Case "Postova banka", "PABK", "Poštová banka"
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = 5
Case "Dexia banka Slovensko", "Dexia"
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = 6
Case "OTP Banka Slovensko", "OTP"
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = 7
Case "UniCredit Bank", "UniCredit"
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = 8
Case "Volksbank (Ludova banka)", "Volksbank"
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = 9
Case "mBank"
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = 10
Case "J and and T Bank", "J&T bank", "J&T", "J&T Banka"
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = 11
Case "ING Bank", "ING"
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = 12
Case "Commerzbank"
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = 13
Case "Istrobanka"
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = 14
Case Else
MsgBox ("Názov stlpca: " & i & " nie je v databaze")
End Select
Next i

objMSGraph.Update
objMSGraph.Quit

Set objDatasheet = Nothing
Set objchart = Nothing
Set objMSGraph = Nothing

End Sub

PaloPa

03.03.10,13:55

Použi funkciu INSTR.
Napr.takto:

Sub Macro1()

Set objMSGraph = ActiveWindow.Selection.ShapeRange.OLEFormat.Object .Application
Set objDatasheet = objMSGraph.Application.DataSheet
Set objchart = objMSGraph.Chart

y = objchart.SeriesCollection(1).Points.Count
z = objchart.SeriesCollection.Count

Select Case z
Case 2
z = 1
Case 4
z = 1
End Select

xName = "VUB;VÚB;VUB banka;SLSP;CSOB;ČSOB" 'atd
aName = Split(xName, ";")

xIdx = "1;1;1;7;3;3"
aIdx = Split(xIdx, ";")

For i = 1 To y
x = objDatasheet.Cells(1, i + 1).Value
For j = LBound(aName) To UBound(aName)
If InStr(1, x, aName(j)) > 0 Then
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = aIdx(j)
Exit For
End If
Next j
Next i

objMSGraph.Update
objMSGraph.Quit

Set objDatasheet = Nothing
Set objchart = Nothing
Set objMSGraph = Nothing

End Sub

Palo

Palo235

08.03.10,07:57

- jo presne toto som potreboval
- jedina nevyhoda tam je ze tam este nieje Else ale to nieje problem do IF-u dopisat
- chcel som prispevok ocenit ale zevraj musim aj niekoho ineho .))

Palo

Palo235

08.03.10,08:59

takto som vyriesil kontrolu prefarbovania:

For i = 1 To Y
x = objDatasheet.Cells(1, i + 1).Value
For j = LBound(aName) To UBound(aName)
If InStr(1, x, aName(j)) > 0 Then
objchart.SeriesCollection(z).Points(i).Interior.Co lorIndex = aIdx(j)
L = L + 1
Exit For
End If
Next j
Next i

Select Case Y
Case Is > L
MsgBox ("Neprefarbilo vsetko! dopln databazu")
End Select