Microsoft Excel & VBA

Tento příspěvek není až tak moc o Excelu, ale má s ním nepřímou souvislost. Obratil se na mě kolega s prosbou zda nevím jak rychle měnit desetinná místa v připojeném (vloženém) grafu z Excelu. Po zběžném hledání jsem usoudil, že Powerpoint 2007 - 2010 vůbec neobsahuje příkazy na změnu desetiných míst přímo z Ribbonu a proto sem napsal doplněk který to umožňuje.

Pro upřesnění situace se podívejte na obrázek.



Je to vložený graf z MS Excel který se dá editovat po double kliku přímo v prostředí Excelu. Takových to grafů je více než 100 a práce je to ve směs automatická. Každý kvartál jsou přidána nová data a jen se rozšiří oblast dat. Problém nastává při snaze zaokrouhlit data na určitý počet desetiných míst které jsou navíc závisle na klientovi = každý preferuje jiný počet des. míst. Současný stav jak zaokrouhlit čísla vidíte na dalším obrazku.



Zkušenější můžou namítnout, že tady stale existuje volba "Linked to Source". Ano pokud tuto volbu zadáme bude počet desetiných míst stejný jako je ve zdrojovém souboru kde už máme standardní možnost změnit počet desetinných míst. Kolega však upřednostil možnost samotného tlačítka kvůli již obrovskému počtu existujicích grafů a také nutnosti při každé úpravě editovat zdrojová data.

Můžete si povšimnout, že je třeba označit řadu, pravé tlačítko, format popisku, vybrat kartu číslo a nastavit počet desetiných míst. Pro další řadu můžete provést stejnou akci pomoci klávesy F4 (opakování posledního kroku), která - dle informaci kolegy - nepracuje v Powerpointu 2010 spolehlivě.
Vytvořil sem proto doplněk pro Powerpoint 2007-2010 který cyklicky mění počet des. míst dle následující logiky

Původní format    Nový formát
     0                           0,0
     0,0                        0,00
     0,00                      0



Uvedená funkce bude pracovat pouze na vložených grafech a pro všechny řady najednou jelikož sem nepřišel na funkci která by vracela kterou řadu uživatel vybral!
Doplněk můžete stahovat zde.

Výpis kódu

Option Explicit

'********************************************************************************
'ChangeDecimalPlaces
'
' Purpose:  Changes decimal places for selected shape.
'           The selected shape must be a Chart then goes through all series
'           and DataLabels and changes decimal places according to the first
'           DataLabel in the first serie
'
' Inputs:   -none-
'
' Outputs:  -none-
'
' Created:  01/26/2011  Premysl Lazecky
'
' Modified: .
'
'********************************************************************************
Sub ChangeDecimalPlaces()
    
    Dim objChart    As Chart
    Dim objSerie    As Series
    Dim objLabel    As DataLabel
    Dim i           As Integer
    Dim j           As Integer
    Dim FirstFormat As String
    
    On Error GoTo ErrorHandler
    
    FirstFormat = vbNullString
    With Windows(1).Selection
        If .Type <> ppSelectionShapes Then
           GoTo ExitRoutine
        End If
        
         If .ShapeRange.Type <> msoChart And .ShapeRange.Type <> msoPlaceholder Then
            GoTo ExitRoutine
        End If
        
        Set objChart = .ShapeRange.Item(1).Chart
        
    End With
      
    For i = 1 To objChart.SeriesCollection.Count
        Set objSerie = objChart.SeriesCollection(i)
        If objSerie.HasDataLabels Then
           For j = 1 To objSerie.DataLabels.Count
               Set objLabel = objSerie.DataLabels(j)
              
               If Len(FirstFormat) = 0 Then
                  FirstFormat = objLabel.NumberFormat
                  ' try to find '#' in the format
                  If InStrRev(FirstFormat, "#") > 0 Then
                     FirstFormat = Mid(FirstFormat, InStrRev(FirstFormat, "#") + 1)
                  End If
               End If
              
               Select Case FirstFormat
                    Case Is = "0"
                          objLabel.NumberFormat = "0.0"
                    Case Is = "0.0"
                          objLabel.NumberFormat = "0.00"
                    Case Is = "0.00"
                          objLabel.NumberFormat = "0"
               End Select
              
               Select Case FirstFormat
                    Case Is = "0%"
                          objLabel.NumberFormat = "0.0%"
                    Case Is = "0.0%"
                          objLabel.NumberFormat = "0.00%"
                    Case Is = "0.00%"
                          objLabel.NumberFormat = "0%"
               End Select
              
           Next j
        End If
    Next i
    
    
ExitRoutine:
    Set objChart = Nothing
    Set objSerie = Nothing
    Set objLabel = Nothing
    Exit Sub
    
ErrorHandler:
    Debug.Print "Error Number: " & Err.Number & vbNewLine & "Error Description: " & Err.Description
    GoTo ExitRoutine
End Sub