Utilisation de l'objet OWC PivotTable
dans un UserForm Excel

Option Explicit


Private Sub UserForm_Initialize()
    Dim Cible As String
    Dim oPvtView As OWC11.PivotView
    Dim oFieldSets As OWC11.PivotFieldSets
    Dim oPvtTotal As PivotTotal
    Dim GrdTotal As Integer
    
    
    'Le catalogue est représenté par le chemin complet du classeur, sans l'extension (.xls).
    Cible = Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 4)
    'Empêche l'affichage de la fenêtre gestion des champs
    PivotTable1.DisplayFieldList = False
    
    
    'Connexion
    PivotTable1.ConnectionString = _
        "Provider=MSDASQL.1;Persist Security Info=True;Extended Properties=" & Chr(34) & _
        "DSN=Fichiers Excel;DBQ=" & ThisWorkbook.FullName & ";DefaultDir=" & ThisWorkbook.Path & _
        ";DriverId=790;MaxBufferSize=2048;PageTimeout=5;" & Chr(34) & _
        ";Initial Catalog=" & Cible
    
    
    'Requète dans la feuille (Feuil2) contenant les données sources
    PivotTable1.CommandText = "SELECT * FROM [Feuil2$]"
    'Exemple pour filtrer les champs
    'PivotTable1.CommandText = "SELECT [Feuil2$].[Ville] FROM [Feuil2$]"
    
    
    Set oPvtView = PivotTable1.ActiveView
    Set oFieldSets = oPvtView.FieldSets


    With oPvtView
        'Ajoute le champ "Ville" dans la zone Row (ligne)
        .RowAxis.InsertFieldSet oFieldSets("Ville")
        .FieldSets("Ville").Fields(0).Caption = "Liste des villes"

        'Ajoute le champ "Valeurs" dans la zone données (Data)
        .DataAxis.InsertFieldSet oFieldSets("Valeurs")
        


        'Ajoute une fonction Nombre
        Set oPvtTotal = oPvtView.AddTotal("Nombre par ville", _
            oFieldSets("Valeurs").Fields(0), plFunctionCount)
        .DataAxis.InsertTotal oPvtTotal
        'Alignement centré
        oPvtTotal.HAlignment = plHAlignCenter
        'Couleur de fond
        oPvtTotal.View.TotalBackColor = RGB(220, 180, 200)

        
        
        'Ajoute une fonction Somme
        Set oPvtTotal = oPvtView.AddTotal("Somme Valeurs par ville", _
            oFieldSets("Valeurs").Fields(0), plFunctionSum)
        .DataAxis.InsertTotal oPvtTotal
       oPvtTotal.HAlignment = plHAlignCenter
        
        
        ' ---- Ajoute un champ calculé Moyenne
         Set oPvtTotal = oPvtView.AddCalculatedTotal("Moyenne", "Moyenne par ville", _
            "[Somme Valeurs par ville] / [Nombre par ville]")
        .DataAxis.InsertTotal oPvtTotal
        oPvtTotal.HAlignment = plHAlignCenter
        'application d'un format
        oPvtTotal.NumberFormat = "00.00"
        '-------------------------------
        
        
        
        ' ---- Ajoute un champ calculé 'Pourcentage'
         
        With PivotTable1.ActiveData
        'récupére le total du champ "Somme Valeurs par ville"
        GrdTotal = .Cells(.RowAxis.RowMember.TotalMember, .ColumnAxis.ColumnMember). _
            Aggregates("Somme Valeurs par ville").Value
        End With
         
        Set oPvtTotal = oPvtView.AddCalculatedTotal("Pourcentage", "Pourcentage du Total", _
            "([Somme Valeurs par ville] / " & GrdTotal & ")")
        .DataAxis.InsertTotal oPvtTotal
        oPvtTotal.HAlignment = plHAlignCenter
        oPvtTotal.NumberFormat = "0.00 %"
        
        '-------------------------------
       
      
        'Mise en forme de la barre de titre
        With .TitleBar
            'La police de caractères
            .Font.Name = "comic sans ms"
            'Le titre
            .Caption = "Le tableau croisé dynamique dans un UserForm"
            'Couleur de fond
            .BackColor = RGB(220, 180, 200)
            'Couleur du texte
            .ForeColor = RGB(0, 0, 0)
        End With
    End With
    
    
    'Masque les détails
    PivotTable1.ActiveData.HideDetails
    
End Sub




'Evènement Clic sur le TCD
'Cet exemple extrait le contenu de la cellule sélectionnée.
Private Sub PivotTable1_Click()
    Dim oPvtSel As Object
    Dim PivotAgg As PivotAggregate
    Dim strTotal As String
    Dim NomCol As String, NomLigne As String
    Dim Resultat As String
   
    'Définit la sélection
    Set oPvtSel = PivotTable1.Selection
   
    If TypeName(oPvtSel) = "PivotAggregates" Then
        Set PivotAgg = oPvtSel.Item(0)
        Resultat = PivotAgg.Value
      
        strTotal = PivotAgg.Total.Caption
        'nom colonne
        NomCol = PivotAgg.Cell.ColumnMember.Caption
        'nom élément ligne
        NomLigne = PivotAgg.Cell.RowMember.Caption
      
        'Remise en forme du résultat en fonction de la colonne cliquée
        If strTotal = "Pourcentage du Total" Then Resultat = Format(Resultat, "0.00 %")
        If strTotal = "Moyenne par ville" Then Resultat = Format(Resultat, "00.00")
        
        Label1.Caption = Resultat & vbCrLf & strTotal & vbCrLf & NomLigne & vbCrLf & NomCol
    End If

End Sub




Private Sub CommandButton1_Click()
    If CommandButton1.Caption = "Bloquer la barre d'outils" Then
        PivotTable1.Toolbar.Enabled = False
        CommandButton1.Caption = "Débloquer la barre"
        Else
        PivotTable1.Toolbar.Enabled = True
        CommandButton1.Caption = "Bloquer la barre d'outils"
    End If
End Sub




Private Sub CommandButton2_Click()
    'Affichage fenêtre gestion des champs
    PivotTable1.DisplayFieldList = True
End Sub




'Création d'un TCD et d'un filtre pour gérer les dates (par numéro de semaine)
Private Sub CommandButton3_Click()
    Dim oPvtView As OWC11.PivotView
    Dim oFieldSets As OWC11.PivotFieldSets
    Dim oPvtTotal As PivotTotal
    
    
    'affichage de la fenêtre gestion des champs
    PivotTable1.DisplayFieldList = True
    
    
    'Requète dans la feuille (Feuil2) contenant les données sources
    'Exemple pour filtrer les champs
    PivotTable1.CommandText = "SELECT [Feuil2$].[Ville],[Feuil2$].[ChampDate] FROM [Feuil2$]"

    Set oPvtView = PivotTable1.ActiveView
    Set oFieldSets = oPvtView.FieldSets
    
    With oPvtView
        'Ajoute le champ "Ville" dans la zone Row (ligne)
        .RowAxis.InsertFieldSet oFieldSets("Ville")
        .FieldSets("Ville").Fields(0).Caption = "Liste des villes"
        
        
        'Ajoute le champ "ChampDate by Week" dans la zone de filtre
        .FilterAxis.InsertFieldSet oFieldSets("ChampDate by Week")
        '.FieldSets("ChampDate by Week").Fields(0).ExcludedMembers = Array("")
        
        
        'Ajoute le champ "ChampDate" dans la zone données (Data)
        .DataAxis.InsertFieldSet oFieldSets("ChampDate")
        
        'Ajoute une fonction Nombre
        Set oPvtTotal = oPvtView.AddTotal("Nombre de dates par ville", _
            oFieldSets("ChampDate").Fields(0), plFunctionCount)
        .DataAxis.InsertTotal oPvtTotal
        'Alignement centré
        oPvtTotal.HAlignment = plHAlignCenter
        'Couleur de fond
        oPvtTotal.View.TotalBackColor = RGB(220, 180, 200)
    End With
    
    
    'Emplêche l'affichage de la fenêtre gestion des champs
    PivotTable1.DisplayFieldList = False
    'Masque les détails
    PivotTable1.ActiveData.HideDetails
End Sub




'Affiche un TCD vierge en ne prenant en compte que la ville "Ville01" dans la requête.
Private Sub CommandButton4_Click()
    PivotTable1.CommandText = "SELECT * FROM [Feuil2$] WHERE Ville='Ville01'"

    'Affiche la fenêtre de gestion des champs
    PivotTable1.DisplayFieldList = True
End Sub




' --------- Ajout et gestion d'un bouton personnalisé dans le pivotTable --------
Private Sub CommandButton5_Click()
   Dim Tb 'As OWC11.????
   Dim NouveauBouton 'As OWC11.????

   'Définit la barre d'outils du contrôle PivotTable.
   Set Tb = PivotTable1.Toolbar

   On Error Resume Next
   
   'Définit l'image qui va être associée au bouton.
   'Privilégiez des fichiers .ico pour la visibilité
   'Dans cet exemple, l'image est stockée dans le même répertoire que le classeur.
   Tb.ImageList.ListImages.Add , "NomImage", LoadPicture(ThisWorkbook.Path & "\bouton.ICO")

   If Err.Number > 0 Then
      MsgBox "L'image 'bouton.ICO' n'a pas pu être chargée: Vérifiez le chemin"
      Exit Sub
   End If
   
   On Error GoTo 0
   
   
   'Définition du nouveau bouton
   'Tb.Buttons.Count + 1 permet de placer le bouton en dernier (sur la droite)
   Set NouveauBouton = Tb.Buttons.Add(Tb.Buttons.Count + 1, "Bouton01", , , "NomImage")
 
   'Applique une info-bulle au nouveau bouton
   NouveauBouton.TooltipText = "Info-bulle du nouveau bouton."

   'Insère le bouton et ajoute une séparation après le dernier bouton existant.
   Tb.Buttons.Add Tb.Buttons.Count, , , 3
   
   PivotTable1.Refresh
   CommandButton5.Enabled = False
End Sub



'L'événement CommandExecute se déclenche après la sélection
'd'une commande de la barre de menus ou de la barre d'outils.
Private Sub PivotTable1_CommandExecute(ByVal Command As Variant, ByVal Succeeded As Boolean)
    
    'L'argument "Command" permet de contrôler la commande exécutée.
    If VarType(Command) = vbString Then
        Select Case Command
            'Déclenche la macro du bouton personnalisé.
            Case "Bouton01"
                NomMacro_01
                
            'Déclenche les macros associées aux nouveaux éléments du menu contextuel
            Case "MenuPerso01"
                NomMacro_02
        
            Case "MenuPerso02"
                NomMacro_03
        End Select
    End If
End Sub


'La macro associée au nouveau bouton
Sub NomMacro_01()
    Dim pTable As OWC11.PivotTable
    Dim pTableView As OWC11.PivotView
    Dim pFieldset As OWC11.PivotFieldSet
    Dim pField As OWC11.PivotField
    Dim Resultat As String
   
    'MsgBox "Essai utilisation bouton personnalisé."
   
    Set pTable = PivotTable1
    Set pTableView = pTable.ActiveView

    'source pour boucler sur les champs:
    'http://msdn2.microsoft.com/fr-fr/library/aa139960(office.10).aspx
    
    'Boucle sur chaque Fieldset
    For Each pFieldset In pTableView.FieldSets
        Resultat = Resultat & "The '" & pFieldset.Name & _
        "' FieldSet contains " & _
        pFieldset.Fields.Count & " field(s):" & vbCrLf

        'Boucle sur chaque Champ
        For Each pField In pFieldset.Fields
            Resultat = Resultat & vbTab & pField.Name & vbCrLf
        Next
   
        Resultat = Resultat & "----" & vbCrLf
   Next

   MsgBox Resultat, , "Liste les champs contenus dans le PivotTable."
End Sub
'-------------------------------------------------




'Gestion du menu contextuel (clic droit dans le PivotTable)
Private Sub PivotTable1_BeforeContextMenu(ByVal x As Long, ByVal y As Long, _
        ByVal Menu As OWC11.ByRef, ByVal Cancel As OWC11.ByRef)
    
    Dim MonMenu()
    Dim j As Integer
    
    '----
    'Permet de désactiver le menu contextuel
    'Cancel = True
    '----
    
    If CheckBox1.Value = False Then
        'Ajoute des nouveaux élements à la suite des éléments existants, dans
            'Le menu contextuel.
        MonMenu = Menu.Value
        j = UBound(MonMenu) + 3
    
        ReDim Preserve MonMenu(j)
    
        MonMenu(j - 2) = Empty
        'Array(Description, MotClé)
        MonMenu(j - 1) = Array("Afficher la chaîne de connexion", "MenuPerso01")
        MonMenu(j) = Array("Afficher le recordset en cours", "MenuPerso02")
        
    Else
    
        'Crée un nouveau menu contextuel personnalisé
        ReDim Preserve MonMenu(1)
        
        'Array(Description, MotClé)
        MonMenu(0) = Array("Afficher la chaîne de connexion", "MenuPerso01")
        MonMenu(1) = Array("Afficher le recordset en cours", "MenuPerso02")
        
    End If
    
    Menu.Value = MonMenu
End Sub


'La macro associée au menu contextuel
Sub NomMacro_02()
    'Affiche la chaîne de connexion
    Label1.Caption = PivotTable1.ConnectionString
End Sub


Sub NomMacro_03()
    'Affiche le paramétrage du Recordset pour l'affichage en cours.
    Label1.Caption = PivotTable1.CommandText
End Sub