Office 365 CREATION DE PLUSIEURS TCD VBA

Charles78

XLDnaute Nouveau
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
 

Fichiers joints

Charles78

XLDnaute Nouveau
Bonjour, pour le dessin et la gestion de la jauge, tu as un excellent exemple pour t'inspirer :
Voir 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

XLDnaute Occasionnel
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

XLDnaute Nouveau
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.
 

eriiiic

XLDnaute Barbatruc
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

XLDnaute Nouveau
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.
 

eriiiic

XLDnaute Barbatruc
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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

XLDnaute Occasionnel
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.
 

eriiiic

XLDnaute Barbatruc
Bonjour,

ou bien utiliser Texte() pour mettre le format voulu :
VB:
="blabla " & texte(A2;"0.00")
eric
 

Charles78

XLDnaute Nouveau
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

XLDnaute Nouveau
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 ?
 

eriiiic

XLDnaute Barbatruc
Pas sûr d'avoir bien compris...
Clic-droit sur un segment puis 'Connexions de rapport...'.
Là tu peux y connecter d'autres TCD.
eric
 

Charles78

XLDnaute Nouveau
Pas sûr d'avoir bien compris...
Clic-droit sur un segment puis 'Connexions de rapport...'.
Là tu peux y connecter d'autres TCD.
eric
Bonjour Eric,

Oui je connaissais cette possibilité mais ça m'oblige quand même à insérer le segment du même filtre pour chaque TCD. Je pense qu'il faut que je "fusionne" mes sources de données pour n'en faire qu'une.

Merci.
 

Charles78

XLDnaute Nouveau
Bonjour à tous,

Aussi je voulais savoir comment faire pour dire à la macro de passer à une autre étape si par exemple la cellule A2 est vide :

- Alors j'ai trouvé comment interrompre la macro avec par exemple If Sheets("LIVRAISON").Range("A2") = "" Then Exit Sub
- Mais je souhaite que si la cellule A2 est vide (16ème ligne de la macro) de passer directement à l'étape MISE EN FORME TABLEAU LIVRAISON

J'ai mis en gras les deux étapes en question.

VB:
Sub KPI_COPACKING()
    '
    ' KPI_COPACKING Macro
    '

    '
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    ' AJUSTEMENT FICHIER SOURCE LIVRAISON
    Sheets("LIVRAISON").Select
    Range("A:E,H:M").Select
    Range("H1").Activate
    Range("A:E,H:M,O:O").Select
    Range("O1").Activate
    Range("A:E,H:M,O:AK").Select
    Range("O1").Activate
    Range("A:E,H:M,O:AK,AM:AM,AN:AN,AP:AP").Select
    Range("AP1").Activate
    Range("A:E,H:M,O:AK,AM:AM,AN:AN,AP:AZ").Select
    Range("AP1").Activate
    Selection.Delete Shift:=xlToLeft
    [B]If Sheets("LIVRAISON").Range("A2") = "" Then Exit Sub [/B]
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Range("D2:E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "#,##0"
    Range("F1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 36
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveCell.FormulaR1C1 = "Vendor"
    Range("F2").Select
    Range("F2:F" & [E65536].End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-5],'[BIBLE Article.xlsx]BIBLE'!R1:R1048576,32,FALSE)"
    Columns("F:F").EntireColumn.AutoFit
    Range("G1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 36
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveCell.FormulaR1C1 = "IDH + Designation"
    Range("G2").Select
    Range("G2:G" & [F65536].End(xlUp).Row).FormulaR1C1 = "=CONCATENATE(RC[-6],"" "",""-"","" "",RC[-5])"
    Columns("G:G").EntireColumn.AutoFit
    Range("H1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 36
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveCell.FormulaR1C1 = "Type of Product"
    Range("H2").Select
    Range("H2:H" & [G65536].End(xlUp).Row).FormulaR1C1 = "=IF(VLOOKUP(RC[-7],'[BIBLE Article.xlsx]BIBLE'!R1:R1048576,17,FALSE)=0,""Autre"",VLOOKUP(RC[-7],'[BIBLE Article.xlsx]BIBLE'!R1:R1048576,17,FALSE))"
    Columns("H:H").EntireColumn.AutoFit
    Range("I1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 36
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveCell.FormulaR1C1 = "Brand"
    Range("I2").Select
    Range("I2:I" & [H65536].End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-8],'[BIBLE Article.xlsx]BIBLE'!R1:R1048576,23,FALSE)"
    Columns("I:I").EntireColumn.AutoFit
    Range("J1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 36
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveCell.FormulaR1C1 = "Business Unit"
    Range("J2").Select
    Range("J2:J" & [I65536].End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-9],'[BIBLE Article.xlsx]BIBLE'!R1:R1048576,19,FALSE)"
    Columns("J:J").EntireColumn.AutoFit
    Range("K1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 36
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveCell.FormulaR1C1 = "Market"
    Range("K2").Select
    Range("K2:K" & [J65536].End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-10],'[BIBLE Article.xlsx]BIBLE'!R1:R1048576,21,FALSE)"
    Range("L1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 36
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveCell.FormulaR1C1 = "PCB SHU / PAL"
    Range("L2").Select
    Range("L2:L" & [K65536].End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-11],'[BIBLE Article.xlsx]BIBLE'!R1:R1048576,13,FALSE)"
    Columns("L:L").EntireColumn.AutoFit
    Range("M1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 36
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveCell.FormulaR1C1 = "Quantity delivered"
    Range("M2").Select
    Range("M2:M" & [L65536].End(xlUp).Row).FormulaR1C1 = "=RC[-8]/RC[-1]"
    Range("M2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "#,##0.00"
    Columns("M:M").EntireColumn.AutoFit
    Range("N1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 36
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveCell.FormulaR1C1 = "Service Rate"
    Range("N2").Select
    Range("N2:N" & [M65536].End(xlUp).Row).FormulaR1C1 = "=RC[-9]/RC[-10]"
    Range("N2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "0.00%"
    Range("O1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 36
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveCell.FormulaR1C1 = "100% ?"
    Range("O2").Select
    Range("O2:O" & [N65536].End(xlUp).Row).FormulaR1C1 = "=IF(AVERAGEIF(C[-8],RC[-8],C[-1])=1,""OUI"",""NON"")"
    Range("P1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 36
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveCell.FormulaR1C1 = "Blocage"
    Range("P2").Select
    Range("P2:P" & [O65536].End(xlUp).Row).FormulaR1C1 = "=IF(RC[-13]=""X2"",""OUI"",""NON"")"
    
    ' SUPRESSION LIGNE AVEC BLOCAGE X2
    For i = Range("A65536").End(xlUp).Row To 2 Step -1
        If Cells(i, 16) Like "*OUI*" Then Rows(i).Delete
    Next i
    
    ' SUPPRESSION LIGNE AVEC VENDOR DIFFERENT DE Subco FR - Copacking
    For i = Range("A65536").End(xlUp).Row To 2 Step -1
        If Not Cells(i, 6) Like "*Subco FR - Copacking*" Then Rows(i).Delete
    Next i
    
    [B]' MISE EN FORME TABLEAU LIVRAISON[/B]
    Range("A1").Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).Name = _
                                                                                     "Tableau1"
    Range("Tableau1[#All]").Select
    ActiveSheet.ListObjects("Tableau1").TableStyle = "TableStyleMedium23"
    ActiveSheet.ListObjects("Tableau1").Name = "LIVRAISON"
 

eriiiic

XLDnaute Barbatruc
Bonjour,

il faut penser à démarrer un nouveau sujet lorsque la question est toute autre...
Teste l'inverse :
VB:
If ta_cellule <>"" Then
   ' y'a ça à faire
endif
' mise en forme
 

Charles78

XLDnaute Nouveau
Bonjour,

il faut penser à démarrer un nouveau sujet lorsque la question est toute autre...
Teste l'inverse :
VB:
If ta_cellule <>"" Then
   ' y'a ça à faire
endif
' mise en forme
Merci Eric.

Effectivement, je vais ouvrir un autre sujet car j'ai d'autres questions.

Merci encore.
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas