Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

CREATION DE PLUSIEURS TCD VBA

C

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
 

Pièces jointes

  • FICHIER CREATION TCD V1.xlsm
    77.4 KB · Affichages: 27
Trier par date Trier par votes
C

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"
 
Vote positif 0 Vote négatif

eriiic

XLDnaute Barbatruc
Bonjour,

Alors là, je ne sais pas trop.
Peut-être en éditant ton titre, dans la liste des versions excel comme c'est là qu'il se place.
Mais sur ce forum ils ne sont pas trop à cheval là-dessus.
eric
 
Vote positif 0 Vote négatif
C

Charles78

XLDnaute Nouveau
Vote positif 0 Vote négatif
C

Charles78

XLDnaute Nouveau
Bonjour à tous,

- J'ai suivi le conseil d'Eric en créant les TCDs manuellement que j'actualise en modifiant les sources de données mais je souhaite tout de même savoir pourquoi avec mon code initial j'avais la liste des champs et les filtres des TCDs bloqués. J'ai creusé encore un peu et en faisant des tests il s'avère que c'est cette partie du code ci-dessous qui fait que les TCDs ont leur liste des champs et filtres bloqués sauf le dernier TCD:

VB: 
For Each objConnection In ActiveWorkbook.Connections
        If objConnection.Type = xlConnectionTypeWORKSHEET Then objConnection.Delete
    Next objConnection

- Pour le test, j'ai donc retiré cette partie du code mais quand je retire cette partie du code, j'ai un message d'erreur lors de l'exécution de la macro;
je joins mon fichier en ayant retiré la partie du code en question pour que vous puissiez voir le résultat et le message d'erreur. Aussi, il semble que pour les deux TCDs qui ont été créés avant le message d'erreur, les résultats des valeurs pour le "TCD RUPTURE RATE" soient faux. En effet d'après la source data "NDR" je devrais avoir:

- OOS (EUR) = 792,58 mais j'obtiens 8 870
- OOS (CON) = 504 mais j'obtiens 8 873
- Number of SKUs = il n'y a que pour cette valeur où j'obtiens le bon résultat à savoir 1

- Ma dernière question est de savoir si la solution ne serait pas de créer plusieurs "objConnection" c'est à dire un "objConnection" pour chaque TCD mais je ne sais pas commet m'y prendre pour ajuster le code de cette façon:
Set objConnection1
Set objConnection2
etc...

Merci à tous pour votre aide.
 

Pièces jointes

  • FICHIER CREATION TCD V2 FORUM.xlsm
    77.2 KB · Affichages: 13
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

H
  • Question
XL 2016 Mettre des titres avec une mise en forme spécifique
Réponses
1
Affichages
410
vgendron
R
  • Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
2 K
TooFatBoy
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
791
Kevin38
K
L
  • Question
Microsoft 365 Changement de couleurs de cellules dans plusieurs feuilles suite à une modification
Réponses
4
Affichages
609
lolo_excelbeginner
L
C
  • Question
Microsoft 365 GRAPHIQUE VBA - COMMENT INDIQUER UNE VALEUR A ZERO SUR LE GRAPHIQUE
Réponses
5
Affichages
2 K
Charles78
C
T
  • Question
Microsoft 365 VBA - TCD - Liste des champs et filtres verrouillés
Réponses
1
Affichages
2 K
Tinytoons
T
  • Résolu(e)
XL 2016 Changer de feuille dans une macro
2
Réponses
28
Affichages
3 K
Staple1600
D
  • Question
XL 2010 Création et mise à jour d'un TCD tableau croisé dynamique avec macro VBA
Réponses
1
Affichages
2 K
chris
M
  • Question
XL 2010 code VBA pour trier une colonne de mon tableau
Réponses
8
Affichages
1 K
Michelrib
M
D
  • Question
Microsoft 365 Modification d'un code VBA
Réponses
8
Affichages
881
Hasco
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…