Pivot style aanmaken via VBA

Status
Niet open voor verdere reacties.
L

leonhnoel

Gebruiker
Lid geworden
4 mei 2016
Berichten
58
Hi all,

ik probeer een pivotstyle te maken via VBA. Nu lukt dat aardig, alleen niet alle gewenste aanpassingen worden door mijn code doorgevoerd.

Volgens mij geef ik in onderstaande code dat alle header en filter text in het wit en bold moet worden weergegeven. Dit wordt echter niet toegepast door de code.

Weet iemand waar het aan ligt?

Code: 
Sub Create_Table_Style()

    ActiveWorkbook.TableStyles.Add ("MyOwnPivotTableStyle")
    
    With ActiveWorkbook.TableStyles("MyOwnPivotTableStyle")
        .ShowAsAvailablePivotTableStyle = True
        .ShowAsAvailableTableStyle = False
        .ShowAsAvailableSlicerStyle = False
        .ShowAsAvailableTimelineStyle = False
    End With
        
    With ActiveWorkbook.TableStyles("MyOwnPivotTableStyle").TableStyleElements(xlWholeTable)
    
        With .Borders(xlEdgeTop)
            .Color = 2952910
            .TintAndShade = 0
            .Weight = xlThin
            .LineStyle = xlNone
        End With
    
        With .Borders(xlEdgeBottom)
            .Color = 2952910
            .TintAndShade = 0
            .Weight = xlThin
            .LineStyle = xlNone
        End With
    
        With .Borders(xlEdgeLeft)
            .Color = 2952910
            .TintAndShade = 0
            .Weight = xlThin
            .LineStyle = xlNone
        End With
        
        With .Borders(xlEdgeRight)
            .Color = 2952910
            .TintAndShade = 0
            .Weight = xlThin
            .LineStyle = xlNone
        End With
        
        With .Borders(xlInsideHorizontal)
            .Color = 2952910
            .TintAndShade = 0
            .Weight = xlThin
            .LineStyle = xlNone
        End With
    
    End With
    
    With ActiveWorkbook.TableStyles("MyOwnPivotTableStyle").TableStyleElements(xlHeaderRow)
    
        With .Font
            .FontStyle = "Bold"
            .TintAndShade = 0
            .ColorIndex = 2
        End With
        
        With .Interior
            .Color = 2952912
            .TintAndShade = 0
        End With
    
    End With
               
    With ActiveWorkbook.TableStyles("MyOwnPivotTableStyle").TableStyleElements(xlPageFieldLabels)
        
        With .Font
            .FontStyle = "Bold"
            .TintAndShade = 0
            .ColorIndex = 2
        End With
        
        With .Interior
            .Color = 2952910
            .TintAndShade = 0
        End With
        
    End With
    
    With ActiveWorkbook.TableStyles("MyOwnPivotTableStyle").TableStyleElements(xlPageFieldValues)
        
        With .Font
           .FontStyle = "Bold"
           .TintAndShade = 0
           .ColorIndex = 2
        End With
        
        With .Interior
           .Color = 2952910
           .TintAndShade = 0
        End With
        
    End With
        
    ActiveWorkbook.TableStyles("MyOwnPivotTableStyle").TableStyleElements(xlTotalRow).Font.FontStyle = "Bold"
           
    ActiveWorkbook.DefaultPivotTableStyle = "MyOwnPivotTableStyle"
    
    
       
End Sub
 

Bijlagen

  • VBPivotStyle.xlsm
    VBPivotStyle.xlsm
    24,7 KB · Weergaven: 21
  • Resultaat na Macro.png
    Resultaat na Macro.png
    3,8 KB · Weergaven: 22
  • Gewenst resultaat.png
    Gewenst resultaat.png
    3,8 KB · Weergaven: 23
Laatst bewerkt:
als je
Code: 
.Linestile=xlNone
eens weg haalt gaat het al wat beter
 
Hi Marco,

ja, ik was inmiddels achter hoe ik de rode horizontale lijnen kon toevoegen.

De kleur en vetheid van de tekst blijft echter een raadsel voor mij..
 
voorlopige voorzichtige analyse, enige serieuze wijziging, doe de Font na Interior en dan gaat het wel + Clear.
Code: 
Sub Create_Table_Style()

   On Error Resume Next
   ActiveWorkbook.TableStyles("MyOwnPivotTableStyle").Delete
   On Error GoTo 0

   ActiveWorkbook.TableStyles.Add ("MyOwnPivotTableStyle")

   With ActiveWorkbook.TableStyles("MyOwnPivotTableStyle")
      .ShowAsAvailablePivotTableStyle = True
      .ShowAsAvailableTableStyle = False
      .ShowAsAvailableSlicerStyle = False
      .ShowAsAvailableTimelineStyle = False
  
      With .TableStyleElements(xlWholeTable).Borders
         .Color = 2952910
         .TintAndShade = 0
         .Weight = xlThin
         .LineStyle = xlNone
      End With

      With .TableStyleElements(xlHeaderRow)
           With .Interior
            .Color = 2952912
            .TintAndShade = 0
         End With
           With .Font
            .FontStyle = "Bold"
            .TintAndShade = 0
            .ThemeColor = xlThemeColorDark1
         End With
    End With

      With .TableStyleElements(xlPageFieldLabels)
            With .Interior
            .Color = 2952910
            .TintAndShade = 0
         End With
         With .Font
            .FontStyle = "Bold"
            .TintAndShade = 0
            .ThemeColor = xlThemeColorDark1
         End With
   
      End With

      With .TableStyleElements(xlPageFieldValues)
         .Clear
           With .Interior
            .Color = 2952910
            .TintAndShade = 0
         End With
         With .Font
            .FontStyle = "Vet"                   '"Bold"
            .TintAndShade = 0
            .ThemeColor = xlThemeColorDark1
         End With
    
      End With

      With .TableStyleElements(xlTotalRow)
         .Clear
             With .Interior
            .Color = 2952910
            .TintAndShade = 0
         End With
         With .Font
            .FontStyle = "Vet"
            .TintAndShade = 0
            .ThemeColor = xlThemeColorDark1
         End With
     
      End With
   End With

   ActiveWorkbook.DefaultPivotTableStyle = "MyOwnPivotTableStyle"
   ActiveSheet.PivotTables("PivotTable5").TableStyle2 = "MyOwnPivotTableStyle"
End Sub
 
Ik kan doen wat ik wil maar de tekstkleur van de HeaderRow krijg ik niet aangepast.

Wel de code een beetje opgeschoond.

Code: 
Sub VenA()
  With ActiveWorkbook
    On Error Resume Next
    .TableStyles("MyOwnPivotTableStyle").Delete
    
    .TableStyles.Add ("MyOwnPivotTableStyle")
    
    With .TableStyles("MyOwnPivotTableStyle")
      .ShowAsAvailablePivotTableStyle = True
      
      With .TableStyleElements(xlWholeTable)
        .Borders(xlEdgeTop).Color = 2952910
        .Borders(xlEdgeBottom).Color = 2952910
        .Borders(xlEdgeLeft).Color = 2952910
        .Borders(xlEdgeRight).Color = 2952910
        .Borders(xlInsideHorizontal).Color = 2952910
      End With
      
      With .TableStyleElements(xlHeaderRow).Font
        .Parent.Interior.Color = 2952910
        .Bold = True
        .ThemeColor = xlThemeColorDark1
      End With
        
      With .TableStyleElements(xlPageFieldLabels).Font
        .Parent.Interior.Color = 2952910
        .Bold = True
        .ThemeColor = xlThemeColorDark1
      End With
      
      With .TableStyleElements(xlPageFieldValues).Font
        .Parent.Interior.Color = 2952910
        .Bold = True
        .ThemeColor = xlThemeColorDark1
      End With
      .TableStyleElements(xlTotalRow).Font.Bold = True
    End With
    .DefaultPivotTableStyle = "MyOwnPivotTableStyle"
  End With
  ActiveSheet.PivotTables("PivotTable5").TableStyle2 = "MyOwnPivotTableStyle"
End Sub
 
Code: 
With .TableStyleElements(xlHeaderRow).Font
      .Color = vbgreen
 
allé VenA, laat je eigen macro even lopen
 

Bijlagen

@cow18, bijzonder dat het met de constante in de xlHeaderRow niet werkt en wel met het indexnummer.

@HSV, had ik natuurlijk ook geprobeerd maar gaf geen resultaat.

Nog een beetje ingekort.

Code: 
Sub VenA()
  With ActiveWorkbook
    On Error Resume Next
    .TableStyles("MyOwnPivotTableStyle").Delete
    .TableStyles.Add ("MyOwnPivotTableStyle")
    
    With .TableStyles("MyOwnPivotTableStyle")
      For j = 7 To 12
        If j <> 11 Then .TableStyleElements(xlWholeTable).Borders(j).Color = 2952910
      Next j
      
      x = Split("1 2 26 27")
      For j = 0 To UBound(x)
        With .TableStyleElements(x(j)).Font
          .Parent.Interior.Color = 2952910
          .Bold = True
          .ThemeColor = 3
        End With
      Next j
    End With
    
    .DefaultPivotTableStyle = "MyOwnPivotTableStyle"
  End With
  ActiveSheet.PivotTables("PivotTable5").TableStyle2 = "MyOwnPivotTableStyle"
End Sub
 
Werkt hier prima.
 
Ipv
Code: 
    .TableStyles.Add ("MyOwnPivotTableStyle")
    
    With .TableStyles("MyOwnPivotTableStyle")
volstaat:

Code: 
    With .TableStyles.Add("MyOwnPivotTableStyle")

    end with
 
En Léon werkt het volgens verwachting? Of is het te veel moeite om even te reageren?
 
Bedankt voor de hulp!

Als ik de code van Cow18 plak zijn de titels wit en vet gedrukt. De rode horizontale strepen zijn dan nog niet aanwezig.

Ik heb nu, na de tip van Cow18, de opmaak van interior en font omgedraaid en dan krijg ik het gewenste resultaat.

Als ik de code van VenA plak zie ik niets gebeuren behalve het weggooien van de aangemaakt pivotstyle (indien aanwezig).


Weet iemand of het ook mogelijk is om de style automatisch op tabular te krijgen en subtotals uit te zetten? Of zijn dit geen aan te passen table style elements via VBA?
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan