Macro TCD

Le 11/07/2013 à 09:49
94gestion-de-stock-taochy-minana-merle-copie.xlsm (161.69 Ko)

Bonjour à tous,

voila j'ai un souci dans mon code pour la création d'un TCD via VBA :

voici le code que vous trouverez dans l'onglet "stocks" dans le développeur

CEtte partie du code est surlignée, mais je ne trouve pas l'erreur..

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

"basededonnées!R1C1:R" & Ligne & "C12", Version:=xlPivotTableVersion14).CreatePivotTable _

TableDestination:="tableau_stocks!R3C1", TableName:="Tableau croisé dynamique1", _

DefaultVersion:=xlPivotTableVersion14

Can you help me please ?

Voici la page de code entière :

Private Sub OptGeneral_Click()

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

'désactivation du bouton de fermeture système de la fenêtre
    If CloseMode = vbFormControlMenu Then Cancel = True

End Sub
Private Sub Cmd_Annuler_Click()
    Unload Stocks
End Sub

Sub Cmd_Valider_Click()

    ' Suppression de toute autre feuille que "base de données"
        '- Désactiver les alertes de suppression des feuilles
    Application.DisplayAlerts = False
        '- Suppression de toutes les feuilles autre que base de données
    Dim s As Integer
    For s = ThisWorkbook.Sheets.Count To 1 Step -1
        If Sheets(s).Name <> "basededonnées" Then
        Sheets(s).Delete
        End If
    Next s
        '- Réactiver les alertes de suppressions des feuilles
    Application.DisplayAlerts = True

    'Ajouter une feuille pour créer le tableau des stocks et la renommer
    Sheets.Add
    ActiveSheet.Name = "tableau_stocks"

    'Création du TCD : TCD + Graph + extraction graph word
    Sheets("basededonnées").Select
    Dim Ligne As Integer
    Ligne = Range("K65536").End(xlUp).Row   'pour prendre toutes les lignes de la base de données
    Range("A1:K" & Ligne).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "basededonnées!R1C1:R" & Ligne & "C12", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="tableau_stocks!R3C1", TableName:="Tableau croisé dynamique1", _
        DefaultVersion:=xlPivotTableVersion14

    Sheets("tableau_stocks").Select
    Cells(3, 1).Select

         'Selectionner le groupe des pièces :

                '-Général
         If OptGeneral Then
    'Sélectionner les ordonnées du tableau (groupe et nom article)
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Groupe")
        .Orientation = xlRowField   'en ordonnées
        .Position = 1               'en premier tri
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Nom_article")
        .Orientation = xlRowField   'en ordonnées
        .Position = 2           'à l'intérieur de chaque tri (général, méca, info, elec)
    End With
    'Selectionner les abscisses du tableau (sotck mini et réel)
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Réel"), _
        "Somme de Stock Réel", xlSum    'en abscisse, prendre la somme des valeurs et non le nombre de valeurs
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Mini"), _
        "Somme de Stock Mini", xlSum    'en abscisse, prendre la somme des valeurs et non le nombre de valeurs
    End If

                '-Mécanique
         If OptMeca Then

    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Groupe")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Nom_article")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Réel"), _
        "Somme de Stock Réel", xlSum
       ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Mini"), _
        "Somme de Stock Mini", xlSum

      'Désélectionner les groupes Electrique et Informatique pour n'avoir que Mécanique
        ActiveWindow.SmallScroll Down:=0  'barre de défilement
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Groupe")
        .PivotItems("Electrique").Visible = False 'décocher le groupe Electrique
        .PivotItems("Informatique").Visible = False 'décocher le groupe Informatique
    End With
    End If
                '-Electrique
         If OptElec Then

    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Groupe")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Nom_article")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Réel"), _
        "Somme de Stock Réel", xlSum
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Mini"), _
        "Somme de Stock Mini", xlSum

        ActiveWindow.SmallScroll Down:=0
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Groupe")
        .PivotItems("Mécanique").Visible = False
        .PivotItems("Informatique").Visible = False
    End With
      End If

                '-Informatique
         If OptInfo Then

    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Groupe")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Nom_article")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Réel"), _
        "Somme de Stock Réel", xlSum
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Mini"), _
        "Somme de Stock Mini", xlSum

        ActiveWindow.SmallScroll Down:=0
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Groupe")
        .PivotItems("Mécanique").Visible = False
        .PivotItems("Electrique").Visible = False
    End With
      End If

    'Trier les données de manière décroissante :
    Range("B4").CurrentRegion.Select
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Nom_article") _
        .AutoSort xlDescending, "Somme de Stock Réel", ActiveSheet.PivotTables( _
        "Tableau croisé dynamique1").PivotColumnAxis.PivotLines(1), 1

    'Créer le Graphique :

    Dim ligne2 As Integer
    ligne2 = Range("B65536").End(xlUp).Row
    Charts.Add      'ajouter un graphique
    ActiveChart.ChartType = xlBarClustered  'Selectionner le type de graphique : histogramme en barres
    ActiveChart.SetSourceData Source:=Range("tableau_stocks!$A$3:$B$" & ligne2) 'chercher les données
    ActiveChart.Axes(xlCategory).TickLabelSpacing = 1
    ActiveSheet.Name = "Graph Stock"    'Renommer la feuille
    ActiveChart.SetElement (msoElementChartTitleAboveChart) 'ajouter un titre au dessus du graph
    ActiveChart.ChartTitle.Text = "Etat des stocks" 'définition du titre du graphique

    'Sortir du Userform :
    Unload Stocks

    'Proposer d'afficher le graphique dans un document Word :
    reponse = MsgBox("Voulez-vous placer le graphique dans un fichier Word ?", vbYesNo + vbQuestion)

    If reponse = vbYes Then
         'Extraction dans Word : enregistré dans MesDocuments
    Dim Graph As ChartObject
    Set wo = CreateObject("Word.Application")   'création d'un document word
    doc = wo.documents.Add
    ActiveChart.CopyPicture Appearance:=xlPrinter, Size:=xlPrinter, Format:= _
        xlPicture  'Pour avoir une image de bonne qualité sous Word
    wo.Selection.Paste  'coller l'image dans word
    wo.activedocument.SaveAs Filename:="Graph Stocks.doc"  'Enregistrer le fichier
    wo.activedocument.Close 'Fermer le document Word

    MsgBox ("Document enregistré sous Graph Stocks.doc dans Mes Documents")
    Else: Cancel = True 'sinon annuler
    End If

    'Worksheets("Graph Stock").Select
    Menu_General.Hide

    'Ajouter un "retour au menu général"
        '- Création d'une forme "Menu Général"
    'Worksheets(Graph_Stock).Select
    'Selection du graphique
    ActiveChart.ChartArea.Select
    'Insertion d'une forme
    ActiveChart.Shapes.AddShape(msoShapeRightArrow, 614.5064566929, 133.3376377953 _
        , 99.3507086614, 46.7533070866).Select
    'Ajouter un texte "Menu Général" à la forme
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "menu général"
    'Alignement du texte en hauteur et en largeur
    Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = _
        msoAlignCenter
    Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    'Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 12).ParagraphFormat. _
        FirstLineIndent = 0
    'Mise en forme de la forme :
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(192, 0, 0)
        .Transparency = 0
        .Solid
    End With
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(192, 0, 0)
        .Transparency = 0
    End With
    'Mise en forme du texte :
    Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
        Size = 11

    'Affecter la macro de Retour au Menu Général :
    ActiveChart.Shapes.Range(Array("Right Arrow 1")).Select
    Selection.OnAction = "gestion_de_stock"

    ActiveChart.ChartArea.Select

End Sub

Private Sub UserForm_Click()

End Sub
Le 11/07/2013 à 13:43

Bonjour

Remplace la partie de code ci-dessous dans ton fichier :

....
Sheets.Add
ActiveSheet.Name = "tableau_stocks"

    'Création du TCD : TCD + Graph + extraction graph word
Dim Ligne As Integer
Ligne = Sheets("basededonnées").Range("K65536").End(xlUp).Row   'pour prendre toutes les lignes de la base de données

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "basededonnées!R1C1:R" & Ligne & "C12").CreatePivotTable _
        TableDestination:="tableau_stocks!R3C1", TableName:="Tableau croisé dynamique1"

     'Selectionner le groupe des pièces :
     '-Général
If OptGeneral Then
....

On pouvvait encore simplifier le code mais bon.

Si ok, lors de ta réponse clique sur le v vert à coté du bouton EDITER pour cloturer le fil

Amicalement

Le 11/07/2013 à 14:31

Tout d'abord je tiens te remercier

J'ai juste une dernière interrogation.

Pour retourner à l'écran général, il y a un léger beugue..

voici le code que vous trouverez dans l'onglet "stocks" dans le développeur

CEtte partie du code est surlignée, mais je ne trouve pas l'erreur..

'Affecter la macro de Retour au Menu Général :

ActiveChart.Shapes.Range(Array("Right Arrow 1")).Select

Private Sub OptGeneral_Click()

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

'désactivation du bouton de fermeture système de la fenêtre
    If CloseMode = vbFormControlMenu Then Cancel = True

End Sub
Private Sub Cmd_Annuler_Click()
    Unload Stocks
End Sub

Sub Cmd_Valider_Click()

    ' Suppression de toute autre feuille que "base de données"
        '- Désactiver les alertes de suppression des feuilles
    Application.DisplayAlerts = False
        '- Suppression de toutes les feuilles autre que base de données
    Dim s As Integer
    For s = ThisWorkbook.Sheets.Count To 1 Step -1
        If Sheets(s).Name <> "basededonnées" Then
        Sheets(s).Delete
        End If
    Next s
        '- Réactiver les alertes de suppressions des feuilles
    Application.DisplayAlerts = True

    'Ajouter une feuille pour créer le tableau des stocks et la renommer
    Sheets.Add
    ActiveSheet.Name = "tableau_stocks"

    'Création du TCD : TCD + Graph + extraction graph word
    Sheets("basededonnées").Select
    Dim Ligne As Integer
    Ligne = Range("K65536").End(xlUp).Row   'pour prendre toutes les lignes de la base de données
    Range("A1:K" & Ligne).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "basededonnées!R1C1:R" & Ligne & "C12").CreatePivotTable _
        TableDestination:="tableau_stocks!R3C1", TableName:="Tableau croisé dynamique1"

    Sheets("tableau_stocks").Select
    Cells(3, 1).Select

         'Selectionner le groupe des pièces :

                '-Général
         If OptGeneral Then
    'Sélectionner les ordonnées du tableau (groupe et nom article)
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Groupe")
        .Orientation = xlRowField   'en ordonnées
        .Position = 1               'en premier tri
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Nom_article")
        .Orientation = xlRowField   'en ordonnées
        .Position = 2           'à l'intérieur de chaque tri (général, méca, info, elec)
    End With
    'Selectionner les abscisses du tableau (sotck mini et réel)
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Réel"), _
        "Somme de Stock Réel", xlSum    'en abscisse, prendre la somme des valeurs et non le nombre de valeurs
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Mini"), _
        "Somme de Stock Mini", xlSum    'en abscisse, prendre la somme des valeurs et non le nombre de valeurs
    End If

                '-Mécanique
         If OptMeca Then

    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Groupe")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Nom_article")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Réel"), _
        "Somme de Stock Réel", xlSum
       ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Mini"), _
        "Somme de Stock Mini", xlSum

      'Désélectionner les groupes Electrique et Informatique pour n'avoir que Mécanique
        ActiveWindow.SmallScroll Down:=0  'barre de défilement
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Groupe")
        .PivotItems("Electrique").Visible = False 'décocher le groupe Electrique
        .PivotItems("Informatique").Visible = False 'décocher le groupe Informatique
    End With
    End If
                '-Electrique
         If OptElec Then

    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Groupe")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Nom_article")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Réel"), _
        "Somme de Stock Réel", xlSum
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Mini"), _
        "Somme de Stock Mini", xlSum

        ActiveWindow.SmallScroll Down:=0
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Groupe")
        .PivotItems("Mécanique").Visible = False
        .PivotItems("Informatique").Visible = False
    End With
      End If

                '-Informatique
         If OptInfo Then

    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Groupe")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Nom_article")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Réel"), _
        "Somme de Stock Réel", xlSum
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Stock Mini"), _
        "Somme de Stock Mini", xlSum

        ActiveWindow.SmallScroll Down:=0
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Groupe")
        .PivotItems("Mécanique").Visible = False
        .PivotItems("Electrique").Visible = False
    End With
      End If

    'Trier les données de manière décroissante :
    Range("B4").CurrentRegion.Select
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Nom_article") _
        .AutoSort xlDescending, "Somme de Stock Réel", ActiveSheet.PivotTables( _
        "Tableau croisé dynamique1").PivotColumnAxis.PivotLines(1), 1

    'Créer le Graphique :

    Dim ligne2 As Integer
    ligne2 = Range("B65536").End(xlUp).Row
    Charts.Add      'ajouter un graphique
    ActiveChart.ChartType = xlBarClustered  'Selectionner le type de graphique : histogramme en barres
    ActiveChart.SetSourceData Source:=Range("tableau_stocks!$A$3:$B$" & ligne2) 'chercher les données
    ActiveChart.Axes(xlCategory).TickLabelSpacing = 1
    ActiveSheet.Name = "Graph Stock"    'Renommer la feuille
    ActiveChart.SetElement (msoElementChartTitleAboveChart) 'ajouter un titre au dessus du graph
    ActiveChart.ChartTitle.Text = "Etat des stocks" 'définition du titre du graphique

    'Sortir du Userform :
    Unload Stocks

    'Proposer d'afficher le graphique dans un document Word :
    reponse = MsgBox("Voulez-vous placer le graphique dans un fichier Word ?", vbYesNo + vbQuestion)

    If reponse = vbYes Then
         'Extraction dans Word : enregistré dans MesDocuments
    Dim Graph As ChartObject
    Set wo = CreateObject("Word.Application")   'création d'un document word
    doc = wo.documents.Add
    ActiveChart.CopyPicture Appearance:=xlPrinter, Size:=xlPrinter, Format:= _
        xlPicture  'Pour avoir une image de bonne qualité sous Word
    wo.Selection.Paste  'coller l'image dans word
    wo.activedocument.SaveAs Filename:="Graph Stocks.doc"  'Enregistrer le fichier
    wo.activedocument.Close 'Fermer le document Word

    MsgBox ("Document enregistré sous Graph Stocks.doc dans Mes Documents")
    Else: Cancel = True 'sinon annuler
    End If

    'Worksheets("Graph Stock").Select
    Menu_General.Hide

    'Ajouter un "retour au menu général"
        '- Création d'une forme "Menu Général"
    'Worksheets(Graph_Stock).Select
    'Selection du graphique
    ActiveChart.ChartArea.Select
    'Insertion d'une forme
    ActiveChart.Shapes.AddShape(msoShapeRightArrow, 614.5064566929, 133.3376377953 _
        , 99.3507086614, 46.7533070866).Select
    'Ajouter un texte "Menu Général" à la forme
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "menu général"
    'Alignement du texte en hauteur et en largeur
    Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = _
        msoAlignCenter
    Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    'Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 12).ParagraphFormat. _
        FirstLineIndent = 0
    'Mise en forme de la forme :
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(192, 0, 0)
        .Transparency = 0
        .Solid
    End With
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(192, 0, 0)
        .Transparency = 0
    End With
    'Mise en forme du texte :
    Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
        Size = 11

    'Affecter la macro de Retour au Menu Général :
    ActiveChart.Shapes.Range(Array("Right Arrow 1")).Select
    Selection.OnAction = "gestion_de_stock"

    ActiveChart.ChartArea.Select

End Sub

Private Sub UserForm_Click()

End Sub

Merci d'avance Dan !

73gestion-de-stock-dan-taochy-minana-merle.xlsm (158.26 Ko)
Rechercher des sujets similaires à "macro tcd"