Zavrieť

Porady

Upraviť

Hlavné

Ďalšie rubriky

Farbenie grafu v PowerPoint pomocou makra

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
Pravidlá a tipy
  • Každý móže napísať len 1 odpoveď. Neskor mozete svoju odpoveď vylepšiť.
  • Odpoveď má priniesť riešenie na otázku, vyvarujte sa hodnotenia otázky.
  • Odpoveď má byť viac o faktoch ako o názoroch.
Dalšie pravidla a tipy
Neregistrovaný
    Ak potrebujete v otázke niečo upresniť, najskôr sa spýtajte na podrobnosti.
    Koncept slúži na uloženie rozpracovanej odpovede, koncept sa zobrazuje len Vám, až kým ho nezverejníte.
    Ak máte podobnú otázku, založte Novú otázku alebo Súvisiacu otázku.
    ❤ Buďte priateľskí ❤
    Sme súčasťou jednej komunity, ktorá si chce vzájomne pomáhať, rozdieľnosť je vítaná ak neubližuje!
    Usporiadať podľa času

    PaloPa je offline (nepripojený) PaloPa

    PaloPa
    Použi funkciu INSTR.
    Napr.takto:

    Code:
    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.ColorIndex = 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
    0

    Palo235 je offline (nepripojený) Palo235

    Palo235
    - 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
    0

    Palo235 je offline (nepripojený) Palo235

    Palo235
    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
    0

    Farbenie grafu v PowerPoint pomocou makra

    Vieš, kto pozná odpoveď?
    Zdieľaj, možno sa nájde odborník Pozvi odborníka, firmu, inštitúciu atď.

    Porady, ktoré by vás mohli zaujímať

    Prihláste sa a sledujte len tie Porady, ktoré Vás zaujímajú.

    Pridať pochvalu

    Ďakujem Dobre píšes Super rada
    Vtipné Si cool Milé
    Poznámočka