CREATION DE PLUSIEURS TCD VBA

Charles78 · 8 Novembre 2019

Bonjour à toutes et à tous,

Bon je me lance pour ma première discussion. Je souhaite réaliser un dashboard avec des KPIs et je passe par une étape de création de plusieurs TCD au nombre de quatre chacun dans son onglet (TCD SERVICE LEVEL, TCD RUPTURE RATE, TCD VALUE AND VOLUME , TCD VALUE AND VOLUME OP REGIE) et ayant sa propore source également chaque source dans un onglet (LIVRAISON, NDR, PRODUCTION, OP REGIE) avec la possibilité d'avoir la fonction "Total distinct". Pour cela, je me suis inspiré d'un code que j'ai trouvé sur Internet dont voici le lien : https://stackoverflow.com/questions/57258768/creating-pivot-table-with-distinct-count-using-vba.

- Mon 1er problème est que suite à l'exécution de la macro, les TCD sont bien créés mais je n'arrive pas à comprendre pourquoi les filtres sont bloqués sauf pour un TCD.

- Mon 2ème problème est que suite à ces TCDs, j'ai créé différentes tables avec des formules dans certaines cellules et je souhaite renvoyer le résulat de ces cellules vers un autre onglet présentant des widgets et deux graphiques (un histogramme et un autre sous forme d'une jauge). J'ai inséré des zones de texte (que j'ai nommé) sur ces widgets (j'ai également nommé les différents rectangles ainsi que le groupe que composé par ces rectangles et ces zones de texte) et c'est sur ces zones de texte que je souhaite renvoyer les valeurs des cellules avec formule provenant des différentes tables. Pour l'histogramme, j'ai réussi à le créer via VBA et ça fonctionne parfaitement. En revanche pour le graphique avec jauge c'est plus difficile mais j'ai inséré une photo pour vous montrer à quoi je souhaite qu'il ressemble.

Ci-dessous mon code et également mon fichier en pièce jointe (vous avez juste à exécuter la macro dont le bouton est dans l'onglet "MACRO" pour voir le résultat).

VB:

Sub KPI_COPACKING()
    '
    ' KPI_COPACKING Macro
    '

    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    
    
    ' CREATION TCD
    Dim objSheetWithData As Worksheet
    Dim objSheetWithPivot As Worksheet
    Dim objListObjectWithData As ListObject
    Dim objConnection As WorkbookConnection
    Dim objPivotCache As PivotCache
    Dim objPivotTable As PivotTable
    Dim objCubeField As CubeField
    Dim objPivotField As PivotField
    
    
    ' CREATION TCD LIVRAISON
    Set objSheetWithData = ActiveWorkbook.Sheets("LIVRAISON")
    Set objSheetWithPivot = ActiveWorkbook.Sheets("TCD SERVICE LEVEL")
    If objSheetWithData.ListObjects.Count > 0 Then
        Set objListObjectWithData = objSheetWithData.ListObjects(1)
    Else
        Set objListObjectWithData = objSheetWithData.ListObjects.Add( _
                                    SourceType:=xlSrcRange, _
                                    Source:=objSheetWithData.Range("LIVRAISON"), _
                                    XlListObjectHasHeaders:=xlYes)
    End If
    For Each objConnection In ActiveWorkbook.Connections
        If objConnection.Type = xlConnectionTypeWORKSHEET Then objConnection.Delete
    Next objConnection
    Set objConnection = ActiveWorkbook.Connections.Add2( _
                        Name:="LIVRAISON", _
                        Description:="TCD SERVICE LEVEL", _
                        ConnectionString:="WORKSHEET;" & ActiveWorkbook.Name, _
                        CommandText:=objListObjectWithData.Parent.Name & "!" & objListObjectWithData.Name, _
                        lCmdtype:=XlCmdType.xlCmdExcel, _
                        CreateModelConnection:=True, _
                        ImportRelationships:=False)
    Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
                        SourceType:=xlExternal, _
                        SourceData:=objConnection)
    With objPivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsNone
    End With
    For Each objPivotTable In objSheetWithPivot.PivotTables
        objPivotTable.TableRange2.Clear
    Next objPivotTable
    Set objPivotTable = objPivotCache.CreatePivotTable( _
                        TableDestination:=objSheetWithPivot.Range("A1"), TableName:="TCD LIVRAISON")
                        
    ' FILTRES
    
    ' IDH + DESIGNATION
    With objPivotTable.CubeFields(7)
        .Orientation = xlPageField
        .Caption = "IDH + Designation"
    End With
    objPivotTable.PageFields(1).Caption = "IDH + Designation"
    
    ' BRAND
    With objPivotTable.CubeFields(9)
        .Orientation = xlPageField
        .Caption = "Brand"
    End With
    objPivotTable.PageFields(2).Caption = "Brand"
    
    ' MARKET
    With objPivotTable.CubeFields(11)
        .Orientation = xlPageField
        .Caption = "Market"
    End With
    objPivotTable.PageFields(3).Caption = "Market"
    
    ' TYPE OF PRODUCT
    With objPivotTable.CubeFields(8)
        .Orientation = xlPageField
        .Caption = "Type of Product"
    End With
    objPivotTable.PageFields(4).Caption = "Type of Product"
    
    ' BUSINESS UNIT
    With objPivotTable.CubeFields(10)
        .Orientation = xlPageField
        .Caption = "Business Unit"
    End With
    objPivotTable.PageFields(5).Caption = "Business Unit"
    
    ' 100% ?
    With objPivotTable.CubeFields(15)
        .Orientation = xlPageField
        .Caption = "100% ?"
    End With
    objPivotTable.PageFields(6).Caption = "100% ?"
    
    ' VALEURS
    
    ' SERVICE LEVEL
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                       AttributeHierarchy:=objPivotTable.CubeFields(14), _
                       Function:=xlAverage, _
                       Caption:="Service Rate")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(1).Caption = "Service Level (%)"
    objPivotTable.DataFields(1).NumberFormat = "0.00%"
    
    ' QUANTITY DELIVERED (PAL)
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                       AttributeHierarchy:=objPivotTable.CubeFields(13), _
                       Function:=xlSum, _
                       Caption:="Quantity delivered")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(2).Caption = "Quantity Delivered (PAL)"
    objPivotTable.DataFields(2).NumberFormat = "#,##0.00"
    
    ' NUMBER OF SKUs
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                       AttributeHierarchy:=objPivotTable.CubeFields(7), _
                       Function:=xlDistinctCount, _
                       Caption:="IDH + Designation")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(3).Caption = "Number of SKUs"
    objPivotTable.DataFields(3).NumberFormat = "#,##0"


    ' CREATION TCD RUPTURE RATE
    Set objSheetWithData = ActiveWorkbook.Sheets("NDR")
    Set objSheetWithPivot = ActiveWorkbook.Sheets("TCD RUPTURE RATE")
    If objSheetWithData.ListObjects.Count > 0 Then
        Set objListObjectWithData = objSheetWithData.ListObjects(1)
    Else
        Set objListObjectWithData = objSheetWithData.ListObjects.Add( _
                                    SourceType:=xlSrcRange, _
                                    Source:=objSheetWithData.Range("NDR"), _
                                    XlListObjectHasHeaders:=xlYes)
    End If
    For Each objConnection In ActiveWorkbook.Connections
        If objConnection.Type = xlConnectionTypeWORKSHEET Then objConnection.Delete
    Next objConnection
    Set objConnection = ActiveWorkbook.Connections.Add2( _
                        Name:="NDR", _
                        Description:="TCD RUPTURE RATE", _
                        ConnectionString:="WORKSHEET;" & ActiveWorkbook.Name, _
                        CommandText:=objListObjectWithData.Parent.Name & "!" & objListObjectWithData.Name, _
                        lCmdtype:=XlCmdType.xlCmdExcel, _
                        CreateModelConnection:=True, _
                        ImportRelationships:=False)
    Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
                        SourceType:=xlExternal, _
                        SourceData:=objConnection)
    With objPivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsNone
    End With
    For Each objPivotTable In objSheetWithPivot.PivotTables
        objPivotTable.TableRange2.Clear
    Next objPivotTable
    Set objPivotTable = objPivotCache.CreatePivotTable( _
                        TableDestination:=objSheetWithPivot.Range("A1"), TableName:="TCD NDR")
    
    ' FILTRES
    
    ' IDH + DESIGNATION
    With objPivotTable.CubeFields(6)
        .Orientation = xlPageField
        .Caption = "IDH + Designation"
    End With
    objPivotTable.PageFields(1).Caption = "IDH + Designation"
    
    ' BRAND
    With objPivotTable.CubeFields(8)
        .Orientation = xlPageField
        .Caption = "Brand"
    End With
    objPivotTable.PageFields(2).Caption = "Brand"
    
    ' MARKET
    With objPivotTable.CubeFields(10)
        .Orientation = xlPageField
        .Caption = "Market"
    End With
    objPivotTable.PageFields(3).Caption = "Market"
    
    ' TYPE OF PRODUCT
    With objPivotTable.CubeFields(7)
        .Orientation = xlPageField
        .Caption = "Type of Product"
    End With
    objPivotTable.PageFields(4).Caption = "Type of Product"
    
    ' BUSINESS UNIT
    With objPivotTable.CubeFields(9)
        .Orientation = xlPageField
        .Caption = "Business Unit"
    End With
    objPivotTable.PageFields(5).Caption = "Business Unit"
    
    ' VALEURS
    
    ' OOS (EUR)
    
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                       AttributeHierarchy:=objPivotTable.CubeFields(5), _
                       Function:=xlSum, _
                       Caption:="CPV (OOS) [EUR]")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(1).Caption = "OOS (EUR)"
    objPivotTable.DataFields(1).NumberFormat = "#,##0.00 €"
    
    ' OOS (CON)
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                       AttributeHierarchy:=objPivotTable.CubeFields(4), _
                       Function:=xlSum, _
                       Caption:="(OOS) [CON]")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(2).Caption = "OOS (CON)"
    objPivotTable.DataFields(2).NumberFormat = "#,##0"
    
    ' NUMBER OF SKUs
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                       AttributeHierarchy:=objPivotTable.CubeFields(6), _
                       Function:=xlDistinctCount, _
                       Caption:="IDH + Designation")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(3).Caption = "Number of SKUs"
    objPivotTable.DataFields(3).NumberFormat = "#,##0"
 
      
    ' CREATION TCD VALUE AND VOLUME
    Set objSheetWithData = ActiveWorkbook.Sheets("PRODUCTION")
    Set objSheetWithPivot = ActiveWorkbook.Sheets("TCD VALUE AND VOLUME")
    If objSheetWithData.ListObjects.Count > 0 Then
        Set objListObjectWithData = objSheetWithData.ListObjects(1)
    Else
        Set objListObjectWithData = objSheetWithData.ListObjects.Add( _
                                    SourceType:=xlSrcRange, _
                                    Source:=objSheetWithData.Range("PRODUCTION"), _
                                    XlListObjectHasHeaders:=xlYes)
    End If
    For Each objConnection In ActiveWorkbook.Connections
        If objConnection.Type = xlConnectionTypeWORKSHEET Then objConnection.Delete
    Next objConnection
    Set objConnection = ActiveWorkbook.Connections.Add2( _
                        Name:="PRODUCTION", _
                        Description:="TCD VALUE AND VOLUME", _
                        ConnectionString:="WORKSHEET;" & ActiveWorkbook.Name, _
                        CommandText:=objListObjectWithData.Parent.Name & "!" & objListObjectWithData.Name, _
                        lCmdtype:=XlCmdType.xlCmdExcel, _
                        CreateModelConnection:=True, _
                        ImportRelationships:=False)
    Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
                        SourceType:=xlExternal, _
                        SourceData:=objConnection)
    With objPivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsNone
    End With
    For Each objPivotTable In objSheetWithPivot.PivotTables
        objPivotTable.TableRange2.Clear
    Next objPivotTable
    Set objPivotTable = objPivotCache.CreatePivotTable( _
                        TableDestination:=objSheetWithPivot.Range("A1"), TableName:="TCD PRODUCTION")

    ' FILTRES
    
    ' IDH + DESIGNATION
    With objPivotTable.CubeFields(9)
        .Orientation = xlPageField
        .Caption = "IDH + Designation"
    End With
    objPivotTable.PageFields(1).Caption = "IDH + Designation"
    
    ' BRAND
    With objPivotTable.CubeFields(11)
        .Orientation = xlPageField
        .Caption = "Brand"
    End With
    objPivotTable.PageFields(2).Caption = "Brand"
    
    ' MARKET
    With objPivotTable.CubeFields(13)
        .Orientation = xlPageField
        .Caption = "Market"
    End With
    objPivotTable.PageFields(3).Caption = "Market"
    
    ' TYPE OF PRODUCT
    With objPivotTable.CubeFields(10)
        .Orientation = xlPageField
        .Caption = "Type of Product"
    End With
    objPivotTable.PageFields(4).Caption = "Type of Product"
    
    ' BUSINESS UNIT
    With objPivotTable.CubeFields(12)
        .Orientation = xlPageField
        .Caption = "Business Unit"
    End With
    objPivotTable.PageFields(5).Caption = "Business Unit"
    
    ' VALEURS
    
    ' STOCK VALUE (EUR)
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                       AttributeHierarchy:=objPivotTable.CubeFields(5), _
                       Function:=xlSum, _
                       Caption:="Stock Value")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(1).Caption = "Stock Value (EUR)"
    objPivotTable.DataFields(1).NumberFormat = "#,##0.00 €"
    
    ' QUANTITY PRODUCED (PAL)
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                       AttributeHierarchy:=objPivotTable.CubeFields(15), _
                       Function:=xlSum, _
                       Caption:="Amount of PAL")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(2).Caption = "Quantity Produced (PAL)"
    objPivotTable.DataFields(2).NumberFormat = "#,##0.00"
    
    ' NUMBER OF SKUs
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                       AttributeHierarchy:=objPivotTable.CubeFields(9), _
                       Function:=xlDistinctCount, _
                       Caption:="IDH + Designation")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(3).Caption = "Number of SKUs"
    objPivotTable.DataFields(3).NumberFormat = "#,##0"


    ' CREATION TCD OP REGIE
    Set objSheetWithData = ActiveWorkbook.Sheets("OP REGIE")
    Set objSheetWithPivot = ActiveWorkbook.Sheets("TCD VALUE AND VOLUME OP REGIE")
    If objSheetWithData.ListObjects.Count > 0 Then
        Set objListObjectWithData = objSheetWithData.ListObjects(1)
    Else
        Set objListObjectWithData = objSheetWithData.ListObjects.Add( _
                                    SourceType:=xlSrcRange, _
                                    Source:=objSheetWithData.Range("OP_REGIE"), _
                                    XlListObjectHasHeaders:=xlYes)
    End If
    For Each objConnection In ActiveWorkbook.Connections
        If objConnection.Type = xlConnectionTypeWORKSHEET Then objConnection.Delete
    Next objConnection
    Set objConnection = ActiveWorkbook.Connections.Add2( _
                        Name:="OP REGIE", _
                        Description:="TCD VALUE AND VOLUME OP REGIE", _
                        ConnectionString:="WORKSHEET;" & ActiveWorkbook.Name, _
                        CommandText:=objListObjectWithData.Parent.Name & "!" & objListObjectWithData.Name, _
                        lCmdtype:=XlCmdType.xlCmdExcel, _
                        CreateModelConnection:=True, _
                        ImportRelationships:=False)
    Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
                        SourceType:=xlExternal, _
                        SourceData:=objConnection)
    With objPivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsNone
    End With
    For Each objPivotTable In objSheetWithPivot.PivotTables
        objPivotTable.TableRange2.Clear
    Next objPivotTable
    Set objPivotTable = objPivotCache.CreatePivotTable( _
                        TableDestination:=objSheetWithPivot.Range("A1"), TableName:="TCD OP REGIE")

    ' FILTRES
    
    ' IDH + DESIGNATION
    With objPivotTable.CubeFields(12)
        .Orientation = xlPageField
        .Caption = "IDH + Designation"
    End With
    objPivotTable.PageFields(1).Caption = "IDH + Designation"
    
    ' BRAND
    With objPivotTable.CubeFields(13)
        .Orientation = xlPageField
        .Caption = "Brand"
    End With
    objPivotTable.PageFields(2).Caption = "Brand"
    
    ' MARKET
    With objPivotTable.CubeFields(14)
        .Orientation = xlPageField
        .Caption = "Market"
    End With
    objPivotTable.PageFields(3).Caption = "Market"
    
    ' TYPE OF PRODUCT
    With objPivotTable.CubeFields(15)
        .Orientation = xlPageField
        .Caption = "Type of Product"
    End With
    objPivotTable.PageFields(4).Caption = "Type of Product"
    
    ' BUSINESS UNIT
    With objPivotTable.CubeFields(16)
        .Orientation = xlPageField
        .Caption = "Business Unit"
    End With
    objPivotTable.PageFields(5).Caption = "Business Unit"
    
    ' VALEURS
    
    ' STOCK VALUE (EUR)
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                       AttributeHierarchy:=objPivotTable.CubeFields(20), _
                       Function:=xlSum, _
                       Caption:="Stock Value")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(1).Caption = "Stock Value (EUR)"
    objPivotTable.DataFields(1).NumberFormat = "#,##0.00 €"
    
    ' QUANTITY PRODUCED (PAL)
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                       AttributeHierarchy:=objPivotTable.CubeFields(17), _
                       Function:=xlSum, _
                       Caption:="Quantity (PAL)")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(2).Caption = "Quantity Produced (PAL)"
    objPivotTable.DataFields(2).NumberFormat = "#,##0.00"
    
    ' NUMBER OF SKUs
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                       AttributeHierarchy:=objPivotTable.CubeFields(12), _
                       Function:=xlDistinctCount, _
                       Caption:="IDH + Designation")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(3).Caption = "Number of SKUs"
    
    
    
    ' TABLE TCD


    ' TABLE TCD LIVRAISON
    Sheets("TCD SERVICE LEVEL").Select
    Range("A12").Select
    ActiveCell.FormulaR1C1 = "Mauvais"
    Range("A13").Select
    ActiveCell.FormulaR1C1 = "Moyen"
    Range("A14").Select
    ActiveCell.FormulaR1C1 = "Bon"
    Range("A15").Select
    ActiveCell.FormulaR1C1 = "Vide"
    Range("A17").Select
    ActiveCell.FormulaR1C1 = "Valeur"
    Range("A18").Select
    ActiveCell.FormulaR1C1 = "Aiguille"
    Range("A19").Select
    ActiveCell.FormulaR1C1 = "Vide"
    Range("A21").Select
    ActiveCell.FormulaR1C1 = "Quantity Delivered (PAL):"
    Range("A22").Select
    ActiveCell.FormulaR1C1 = "Number of SKUs:"
    Range("A23").Select
    ActiveCell.FormulaR1C1 = "IDH + Designation"
    Range("B12").Select
    ActiveCell.FormulaR1C1 = "0.8"
    Range("B13").Select
    ActiveCell.FormulaR1C1 = "0.11"
    Range("B14").Select
    ActiveCell.FormulaR1C1 = "0.1"
    Range("B15").Select
    ActiveCell.FormulaR1C1 = "0.99"
    Range("B12:B15").Select
    Selection.Style = "Percent"
    Range("A12:B15").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("B17").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
                           "=GETPIVOTDATA(""[Measures].[Moyenne de Service Rate]"",R8C1)"
    Range("B17").Select
    Selection.NumberFormat = "0.00%"
    Range("B18").Select
    Selection.Style = "Percent"
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Normal"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveCell.FormulaR1C1 = "2%"
    Range("B19").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-8]C:R[-4]C)-(R[-1]C+R[-2]C)"
    Range("A17:B19").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("B21").Select
    ActiveCell.FormulaR1C1 = _
                           "=CONCATENATE(RC[-1],""     "",GETPIVOTDATA(""[Measures].[Somme de Quantity delivered]"",R8C1))"
    Range("B22").Select
    ActiveCell.FormulaR1C1 = _
                           "=IF(R[-21]C<>""All"","" "",CONCATENATE(RC[-1],""     "",GETPIVOTDATA(""[Measures].[Total distinct de IDH + Designation]"",R8C1)))"
    Range("B23").Select
    ActiveCell.FormulaR1C1 = _
                           "=IF(AND(R[-22]C<>""All"",R[-21]C=""All"",R[-20]C=""All"",R[-19]C=""All"",R[-18]C=""All"",R[-17]C=""All""),R[-22]C,"" "")"
    Range("A21:B23").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit


    ' TABLE TCD PRODUCTION
    Sheets("TCD VALUE AND VOLUME").Select
    Range("A12").Select
    ActiveCell.FormulaR1C1 = "Stock Value:"
    Range("A13").Select
    ActiveCell.FormulaR1C1 = "Quantity Produced (PAL):"
    Range("A14").Select
    ActiveCell.FormulaR1C1 = "Number of SKUs:"
    Range("A15").Select
    ActiveCell.FormulaR1C1 = "IDH + Designation"
    Range("B12").Select
    ActiveCell.FormulaR1C1 = _
                           "=CONCATENATE(RC[-1],""     "",""€"","" "",GETPIVOTDATA(""[Measures].[Somme de Stock Value]"",R7C1))"
    Range("B13").Select
    ActiveCell.FormulaR1C1 = _
                           "=CONCATENATE(RC[-1],""     "",GETPIVOTDATA(""[Measures].[Somme de Amount of PAL]"",R7C1))"
    Range("B14").Select
    ActiveCell.FormulaR1C1 = _
                           "=IF(R[-13]C<>""All"","" "",CONCATENATE(RC[-1],""     "",GETPIVOTDATA(""[Measures].[Total distinct de IDH + Designation]"",R7C1)))"
    Range("B15").Select
    ActiveCell.FormulaR1C1 = "=IF(R[-14]C<>""All"",R[-14]C,"" "")"


    ' TABLE TCD OP REGIE
    Sheets("TCD VALUE AND VOLUME OP REGIE").Select
    Range("A12").Select
    ActiveCell.FormulaR1C1 = "Stock Value:"
    Range("A13").Select
    ActiveCell.FormulaR1C1 = "Quantity Produced (PAL):"
    Range("A14").Select
    ActiveCell.FormulaR1C1 = "Number of SKUs:"
    Range("A15").Select
    ActiveCell.FormulaR1C1 = "IDH + Designation"
    Range("B12").Select
    ActiveCell.FormulaR1C1 = _
                           "=CONCATENATE(RC[-1],""     "",""€"","" "",GETPIVOTDATA(""[Measures].[Somme de Stock Value]"",R7C1))"
    Range("B13").Select
    ActiveCell.FormulaR1C1 = _
                           "=CONCATENATE(RC[-1],""     "",GETPIVOTDATA(""[Measures].[Somme de Quantity (PAL)]"",R7C1))"
    Range("B14").Select
    ActiveCell.FormulaR1C1 = _
                           "=IF(R[-13]C<>""All"","" "",CONCATENATE(RC[-1],""     "",GETPIVOTDATA(""[Measures].[Total distinct de IDH + Designation]"",R7C1)))"
    Range("B15").Select
    ActiveCell.FormulaR1C1 = "=IF(R[-14]C<>""All"",R[-14]C,"" "")"

     ' CREATION GRAPHIQUE NDR
    
    Dim wksPivot As Worksheet
    Dim wksDest As Worksheet
    Dim oChart As Chart
    Dim oPT As PivotTable
    Dim rDest As Range
    
    Set wksPivot = Worksheets("TCD RUPTURE RATE")
    Set wksDest = Worksheets("DASHBOARD")
    
    Set oPT = wksPivot.PivotTables("TCD NDR")
    
    Set rDest = wksDest.Range("B113")
    
    With rDest
        Set oChart = wksDest.ChartObjects.Add(Left:=.Left, Top:=.Top, Width:=400, Height:=255).Chart
    End With
    
    With oChart
        .ChartType = xlColumnClustered
        .SetSourceData oPT.TableRange1
        .ApplyLayout (4)
        .Parent.Name = "Graphique NDR"
        .ShowAllFieldButtons = False
        .Axes(xlCategory).Delete
        .Axes(xlValue).Delete
        .HasTitle = True
        .ChartTitle.Characters.Text = "RUPTURE RATE"
        .ChartTitle.Font.Bold = True
        .ChartTitle.Font.Size = 24
    End With
    wksDest.Activate
    
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    

End Sub

sylvanu · 9 Novembre 2019

Bonjour, pour le dessin et la gestion de la jauge, tu as un excellent exemple pour t'inspirer :

Le monde des études : Faire un graphique “Jauge” avec Excel

lemondedesetudes.fr

Charles78 · 9 Novembre 2019

sylvanu à dit:
Bonjour, pour le dessin et la gestion de la jauge, tu as un excellent exemple pour t'inspirer :

Le monde des études : Faire un graphique “Jauge” avec Excel

lemondedesetudes.fr

Regarde la pièce jointe 1045649

Bonsoir Sylvanu, merci pour ton retour. Effectivement hier j'ai passé la nuit à essayer de réaliser le graphique sous forme de jauge avec l'aide d'un tuto sur youtube. J'ai utilisé l'enregistreur de macro et ça à l'air de fonctionner. En revanche je n'arrive toujours pas à trouver pourquoi j'ai les filtres et les valeurs bloqués.

sylvanu · 9 Novembre 2019

Bonsoir Charles78, malheureusement sur mon XL2007 j'ai une erreur sur : lCmdtype:=XlCmdType.xlCmdExcel.
Je n'ai toujours pas compris pourquoi, c'est pour ça que je n'ai pas insister sur ce point.

Charles78 · 9 Novembre 2019

sylvanu à dit:
Bonsoir Charles78, malheureusement sur mon XL2007 j'ai une erreur sur : lCmdtype:=XlCmdType.xlCmdExcel.
Je n'ai toujours pas compris pourquoi, c'est pour ça que je n'ai pas insister sur ce point.

En espérant que d'autres membres de la communauté puissent répondre mais merci d'avoir essayé. Moi je n'ai pas de message d'erreur mais j'ai ce problème de blocage de la liste des champs.

eriiic · 9 Novembre 2019

Bonjour,

pas de plantage chez moi (excel 2019) mais filtres bloqués également.

Qu'est-ce qui te pousse à créer les TCD par macro ?
Le plus simple est de les créer manuellement, la macro ne servant qu'à mettre à jour la source.
En plus ça te permet de les faire évoluer facilement en cas de besoin selon l'avancée de ton projet.
eric

Charles78 · 9 Novembre 2019

eriiiic à dit:
Bonjour,

pas de plantage chez moi (excel 2019) mais filtres bloqués également.

Qu'est-ce qui te pousse à créer les TCD par macro ?
Le plus simple est de les créer manuellement, la macro ne servant qu'à mettre à jour la source.
En plus ça te permet de les faire évoluer facilement en cas de besoin selon l'avancée de ton projet.
eric

Bonsoir Eric,

Avant de créer les TCD, les fichiers sources sont modifiés par macro car il y a beaucoup de colonnes à modifier ainsi que des filtres avec des lignes supprimées... Ce que j'ai envoyé est justement les fichiers sources après modifications par macro mis sous forme de tableau afin de créer les TCD. La macro va être utilisée par différents collègues toutes les semaines et c'est pourquoi je souhaite tout automatiser.
Par rapport aux TCD si je laisse dans le code seulement un TCD les filtres ne sont pas bloqués mais quand j'en mets plusieurs il n'y a que le dernier TCD positionné dans la macro dont les filtres ne sont pas bloqués. Aussi, étant débutant en VBA je souhaite un maximum pratiquer. Je pense que dans le code il y a quelque chose à modifier ou a supprimer.

Merci en tout cas d'avoir jeté un coup d'oeil.

eriiic · 9 Novembre 2019

Ca ne répond pas à ma question.
Si tu mets à jour la source d'un TCD créé manuellement après le passage de ta moulinette il se passe quoi ?
Tout explose ? C'est tout faux ou c'est tout bon ?
Utilise l'enregistrement de macro pour avoir le code de changement de source
eric

Charles78 · 10 Novembre 2019

eriiiic à dit:
Ca ne répond pas à ma question.
Si tu mets à jour la source d'un TCD créé manuellement après le passage de ta moulinette il se passe quoi ?
Tout explose ? C'est tout faux ou c'est tout bon ?
Utilise l'enregistrement de macro pour avoir le code de changement de source
eric

Je ne suis pas chez moi actuellement mais dès que je rentre je me mets dessus et te tiens au courant. Merci.

Charles78 · 10 Novembre 2019

Charles78 à dit:
Je ne suis pas chez moi actuellement mais dès que je rentre je me mets dessus et te tiens au courant. Merci.

Bonjour Eric,

J'ai suivi ton conseil et j'ai créé manuellement les TCDs que j'ai mis à jour en modifiant les fichiers sources et ça fonctionne parfaitement. J'ai juste une petite question par rapport aux tables que j'ai créé sur la même feuille des TCDs. Au niveau des valeurs du TCD, j'ai changé le format de nombre en choisissant par exemple monétaire, pourcentage ou nombre et avec deux décimales. Le problème est que quand je mets la formule "CONCATENER" pour reprendre une cellule avec du texte et la cellule où figure la valeur de la liste des champs dont j'ai modifié le format du nombre, il m'affiche bien le texte suivi de la valeur mais ça ne prend pas en compte le changement du format du nombre et je me retrouve avec des chiffres avec plus de 5 chiffres après la virgule.

sylvanu · 10 Novembre 2019

Bonjour, tu confonds la valeur et son affichage. La modification de format ne change pas la valeur.
Exemple : en A1 tu met 1.23456 avec un format 2 chiffres après la virgule il va t'afficher 1.23
Si en A2 tu met =A1+1 il va t'afficher ... la valeur 2.23456 car la valeur en A1 n'a pas été affectée par le format.
Pour résoudre ton problème le mieux est de faire un arrondi(X,2) dans ta concaténation.

eriiic · 10 Novembre 2019

Bonjour,

ou bien utiliser Texte() pour mettre le format voulu :

VB:

="blabla " & texte(A2;"0.00")

eric

Charles78 · 10 Novembre 2019

sylvanu à dit:
Bonjour, tu confonds la valeur et son affichage. La modification de format ne change pas la valeur.
Exemple : en A1 tu met 1.23456 avec un format 2 chiffres après la virgule il va t'afficher 1.23
Si en A2 tu met =A1+1 il va t'afficher ... la valeur 2.23456 car la valeur en A1 n'a pas été affectée par le format.
Pour résoudre ton problème le mieux est de faire un arrondi(X,2) dans ta concaténation.

Bonjour Sylvanu,

J'ai très bien compris et ça fonctionne !!!

Charles78 · 10 Novembre 2019

eriiiic à dit:
Bonjour,

ou bien utiliser Texte() pour mettre le format voulu :

VB:

="blabla " & texte(A2;"0.00")

eric

Eric,

C'est effectivement la syntaxe que j'ai utilisé. Merci à vous deux.

Charles78 · 10 Novembre 2019

Bonsoir à tous,

J'ai une dernière question par rapport à la possibilité d'insérer des segments. Mes 4 TCDs ont cinq filtres identiques et au lieu par exemple d'insérer 4 fois le même segment pour le filtre "IDH + Designation", est-il possible d'insérer le segment seulement une fois et qui afficherait tous les produits qui sont dans les différents fichiers source des 4 TCDs ?

Effectuez une recherche sur Excel Downloads...

CREATION DE PLUSIEURS TCD VBA

Charles78

XLDnaute Nouveau

Pièces jointes

sylvanu

XLDnaute Barbatruc

Le monde des études : Faire un graphique “Jauge” avec Excel

Charles78

XLDnaute Nouveau

Le monde des études : Faire un graphique “Jauge” avec Excel

sylvanu

XLDnaute Barbatruc

Charles78

XLDnaute Nouveau

eriiic

XLDnaute Barbatruc

Charles78

XLDnaute Nouveau

eriiic

XLDnaute Barbatruc

Charles78

XLDnaute Nouveau

Charles78

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

Charles78

XLDnaute Nouveau

Charles78

XLDnaute Nouveau

Charles78

XLDnaute Nouveau

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums