Les malheurs des pivotants

Question

J'ai l'impression que tous les exemples donnés par d'autres personnes correspondent à ce que j'ai déjà dans mon code. Mais dans mon cas, rien ne résout le problème. Voici donc le code complet avec une pause pour montrer où j'ai un problème :

    Sub CreatePivot()
        ' Define RngTarget and RngSource as Range type variables
        Dim RngTarget As Range
        Dim RngSource As Range
        Dim intLastCol As Integer
        Dim intLCPivot As Integer
        Dim intLRPivot As Integer
        Dim intCntrCol As Integer
        Dim intX, intY As Integer
        Dim ws1, ws2 As Worksheet
        Dim pt As PivotTable
        Dim cf As FormatCondition

        Set ws1 = ThisWorkbook.Sheets("Sheet1")
        Set ws2 = ThisWorkbook.Sheets("Sheet2")
        ws2.Cells.Clear

        ' RngTarget is where the PivotTable will be created (ie: Sheet2, Cell B3)
        Set RngTarget = ws2.Range("B3")

        ' RngSource defines the Range that will be used to create the PivotTable
        Set RngSource = ws1.UsedRange

        ' Select the Range
        ws1.Select  ' Not sure why this is needed, but 1004 if omitted
        RngSource.Select

        ' Copy the Range into the clipboard
        RngSource.Copy

        ' Create a new PivotTable using the RngSource defined above
        ActiveWorkbook.PivotCaches.Create(xlDatabase, RngSource).CreatePivotTable RngTarget, "PivotB3"
        Set pt = RngTarget.PivotTable

    '' This is where the the problem is. After the pivottable is created, if I look at sheet2, I see
    '' only the wizard. Like this: http://wikisend.com/download/617932/ptwizard.jpg
    '' I need to have all of the fields automatically selected to be included in
    '' the report. I haven't been able to test anything beyond this, although it compiles without
    '' a problem.

        ' Get the last col and row from the pivottable
        intLCPivot = pt.DataBodyRange.Columns(pt.DataBodyRange.Columns.Count).Column
        intLRPivot = pt.DataBodyRange.Rows(pt.DataBodyRange.Rows.Count).Row

        ' Get the last used column from the data table
        intLastCol = RngSource.Columns(RngSource.Columns.Count).Column

        ' Select the Pivot table so we can apply the conditional formats
        pt.PivotSelect "", xlDataAndLabel, True

    '' This also causes an error. I need to be able to get the conditional format from Sheet1:B3 and apply it
    '' to all Data cells in the PivotTable Report, instead of hardcoding the format like it is now.

        'cf = ws1.Range("B3").FormatCondition

        ws2.Select
        For intX = 1 To intLCPivot
            For intY = 1 To intLRPivot
                ws2.Cells(4, intCntrCol).Select ' Select the current Sum column
                Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=5000" ' Set conditional format to less than 5000
                Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority ' Take priority over any other formats
                With Selection.FormatConditions(1).Font ' Use the Font property for the next operations
                    .ThemeColor = xlThemeColorLight1 ' Set it to the default (if it does not meet the condition)
                    .TintAndShade = 0 ' Same as above
                End With
                With Selection.FormatConditions(1).Interior
                    .PatternColorIndex = xlAutomatic
                    .Color = 65535 ' Set the background color to Yellow
                    .TintAndShade = 0
                End With
                Selection.FormatConditions(1).StopIfTrue = False
                'Selection.FormatConditions(1).ScopeType = xlFieldsScope ' Apply the format to all rows that match "Sum of xxxx"
            Next intY
        Next intX
    End Sub

Answer 1

Si vous ajoutez ceci à votre script à la place des lignes d'erreur, vous obtiendrez tous leurs noms et les ajouterez au pivot :

For Each p In pt.PivotFields
    Debug.Print p.Name
    pt.AddDataField p,,xlSum
Next

Je suis sûr que cela vous permettra de franchir la ligne. :)