Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

[bouclesdor]

Bonjour à tous,

Après de nombreuses recherches sur internet pour trouver un code VBA pour faire un tableau dynamique croisé avec plusieurs critères, j'ai trouvé un code que j'ai adapté à mon fichier. Jusque là tout allait bien.

J'ai fait plusieurs TDC dans plusieurs onglets car j'analyse mon fichier des ventes selon les années, selon les pays, etc... dans tous mes onglets qui contiennent des TDC j'ai un bouton qui me sert de Reestablish Connection et j'ai le code suivant qui y est rattaché: (je présice que je ne suis pas la pro des codes et pour ce code j'arrive pas a comprendre ce qu'il fait...)

Sub ReestablishConnection_produits()
Dim strFile As String
Dim strPath As String
Dim strCon As String

With ThisWorkbook
strPath = .Path
strFile = .FullName

strCon = _
"ODBC;" & _
"DSN=Excel Files;" & _
"DBQ=" & strFile & ";" & _
"DefaultDir=" & strPath & ";" & _
"DriverId=790;" & _
"MaxBufferSize=2048;" & _
"PageTimeout=5"

With .Worksheets("produits$")
If .PivotTables.Count > 0 Then .PivotTables(PIVOTNAME).PivotCache.Connection = strCon
End With
End With
End Sub

Lorsque j'ouvre mon fichier excel, j'ai un code d'erreur

" Run time error 1004
The connection for this pivot table has been deleted"

Et lorsque je fais debug la partie du code VBA qui vient en jaune est:

If .PivotTables.Count > 0 Then .PivotTables(PIVOTNAME).PivotCache.Connection = strCon

Je sais que vous aimez travailler avec un fichier mais comme se sont des infos confidentielle je ne peux mettre le fichier alors j'espère qu'avec ses informations vous pourrez m'aider ou me mettre sur une piste de quoi faire pour résoudre mon problème. J'ai inscrit ce code VBA parce qu'il était dans le fichier d'exemple qu ej'ai trouvé sur internet mais j'arrive pas à comprendre à quoi il sert alors peut-etre que c'est un problème vraiment niaiseux mais pour moi la débutante il est insurmontable... alors je fais appel à vous...

Merci à l'avance et si vous avez des questions n'hésitez pas je vais vous répondre du mieux que je peux car je veux résoudre se problème.

Bouclesdor

 

[bouclesdor]

Re : Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

à force de faire des essaies et erreurs j'ai enlever une partie du code que je ne savais pas à quoi il servait et que de ce que je comprennais ne devait pas servir car j'ai un TDC dans toutes mes feuilles j'ai enlever et c'est là que mon débugger m'indiquait un erreur...

With .Worksheets("produits$")
If .PivotTables.Count > 0 Then .PivotTables(PIVOTNAME).PivotCache.Connection = strCon
End With

Alors mon problème semble résolu!!

Je vais donc passer a un autre problème voici ma question au cas ou quelqu'un pourrait m'aider!!

Comme j'ai dit j'ai plein de TDC dans mes onlgets et je voudrais que mes tableaux ce mettre à jour lors de l'ouverture car tous les jours il y a des ajouts de ventes de produits alors mes tableaux changent continuellement alors au lieu de devoir appuyer sur mes boutons pour refaire mes tableaux dynamique 1 par 1 je voudrais trouvé un code qui le ferait pour moi...

Merci à l'avance.

Bouclesdor

 

[tototiti2008]

Re : Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

Bonjour bouclesdor,

Attention, on a quelques ours qui trainent sur le forum

A mettre à l'ouverture du classeur (dans Workbook_Open de ThisWorkbook)

ThisWorkbook.RefreshAll

 

[bouclesdor]

Re : Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

Boujour Tototiti2008,

Merci de me prévenir... je vais faire très attention aux ours !! miam miam du bon gruau!! (un peu d'humour lorsqu'on se casse la tête ça ne fait pas de tord!! )

pour ta formule j'ai trouvé ce code ce matin et d'autres semblable et ça ne fonctionne pas j'ai aussi essayer de tout simplement sélectionné un TDC et de faire Refresh dans le menu et j'ai le même code d'erreur donc je sais que le problème n'est pas le code mais bien dans mon fichier... mais quoi....

Mon code d'erreur lorsque je fais Refresh est:

ODBC excel Driver login failed
cannot update database or object is read only.

Mon fichier n'est pas en read only donc c'est pas ça le problème mais quoi...

Est-ce parce que j'ai bâti mes TDC avec des codes VBA?

Si vous pouvez m'aider ou me mettre sur une piste de c'est quoi qui peut causer ce code vous ça serait grandement apprécié....

PS je vais vous joindre mon code VBA au complet au cas où ça vous aiderait!

Merci à l'avance,
Bouclesdor

 

[bouclesdor]

Re : Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

voilà mon code:

(je vous avise que je ne suis pas experte déjà je me trouve popire d'avoir réussi à faire fonctionner ce code mais je sais qu'il y a surement des moyens plus simple d'écrire tout ça... )'

ATTENTION C'EST LONG....

*** voir message plus bas j'ai essayé de mettre entre balise pour une lecture plus facile...***

 

[bouclesdor]

Re : Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

De ce que je comprends car j'ai un autre message d'erreur au niveau de la sécurité qui me dit que mon fichier va chercher de l'info dans une base extérieur et ça me demande si j'accepte ou pas.... donc...

c'est probablement dans le code VBA mais j'ai aucune idée à quoi ça sert car toute mon info est dans le même fichier excel...??? bizzard... quelqu'un sait pourquoi le code est inscrit comme ça ou si c'est réellement nécessaire...??

Merci encore une fois,

Bouclesdor

 

[Paritec]

Re : Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

Bonsoir Boucledor le forum
bon plutôt que de balancer 1 kilomètre de code illisible même pas mis avec les balises de code!!!
Tu nous fais un petit fichier exemple de ce que tu as, et de ce que tu souhaites obtenir et là on pourra rationaliser, je pense, ta macro
N'oublies pas de mettre des explications dans ton fichier
à te relire
a+
papou

 

[bouclesdor]

Re : Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

mon problème à mettre mon fichier c'est qu'il contient des infos confidentiels de la compagnie... sinon c'est certain que j'aurais joint mon fichier mais je vais regarder si je peux effacer plein d'info et mettre un fichier d'exemple ça serait plus simple... je vous l'accord!!

2e question: est-ce ça mettre en balise.... ??

J'ai mis mon code plus bas grâce à Papou! Merci encore!

Merci encore!

 

[bouclesdor]

Re : Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

bon voici un fichier test. prendre note que j'ai enlevé plein d'onglets et d'info mais la base est là.

Je veux que mes tableaux dynamique croisée se mettre à jour à l'ouverture mais j'ai un code d'erreur lorsque je fais refresh dans le menu alors j'ai un autre problème quelque part dans mon fichier...

Je vous remercie à l'avance de votre aide!

Bonne soirée

Bouclesdor

 

[Paritec]

Re : Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

Bonjour boucle d'or le forum
non pour la balise de code, tu sélectionnes comme tu as fait mais tu cliques le # au dessus
tu y étais presque sauf que tu as cliqué sur citation !!!
a+
papou

PS:je regarde ton fichier ce soir là je pars bosser

 

[bouclesdor]

Re : Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

Merci Papou je ne savais pas à quoi il servait le signe #.
Alors voici mon code avec les balises (du moins j'espère...)
Comme ça je saurai comment vous envoyer mon code la prochaine fois! Merci Papou!

' *** MODULE POUR LA FEUILLE CLIENTS$  ***

'---------------------------------------------------------------------------------------
' Procedure : CreateConnection
' Author    : KL (Kirill Lapin)
' Date      : 18/08/2009
' Updated   : 27/09/2010
' Purpose   : Demonstration
' Comments  : Special thanks to
'             Debra Dalgleish for helping to fix ODBC driver issue
'             Hector Miguel Orozco Diaz for the "DeleteConnections_12" idea
'             Ron de Bruin for his tip on FileFormat selection
'---------------------------------------------------------------------------------------
Option Explicit
Const PIVOTNAME = "TestPivot"
Dim strFileExt As String
Dim lngFileFormat As Long

'
Sub CreateConnection_client()
    Dim PT As PivotTable
    Dim PC As PivotCache
    Dim strFile As String
    Dim strFileTemp As String
    Dim strPath As String
    Dim arrSheets As Variant
    Dim strSQL As String
    Dim strCon As String
    Dim i As Long
    
    '   Sheets to consolidate
    '*****************************************************************************
    arrSheets = Array("Ventes 10-11", "ventes 09-10", "ventes 08-09", "ventes 07-08")
    '*****************************************************************************
    
    If Val(Application.Version) > 11 Then
        DeleteConnections_client
        CheckFileFormat_client
    Else
        strFileExt = ".xls"
        lngFileFormat = xlNormal
    End If
    
    Application.ScreenUpdating = False
    With ThisWorkbook
        strPath = .Path
        strFile = .FullName
        strFileTemp = strPath & "\DBtemp" & format(Now, "yyyymmddhhmmss") & strFileExt
        ActiveSheet.Cells.Clear
        .Worksheets(arrSheets).Copy
    End With
    
    With ActiveWorkbook
        .SaveAs strFileTemp, lngFileFormat
        .Close
    End With
    
    For i = LBound(arrSheets) To UBound(arrSheets)
        If arrSheets(i) <> ActiveSheet.Name Then
            If strSQL = "" Then
                strSQL = "SELECT * FROM [" & arrSheets(i) & "$]"
            Else
                strSQL = strSQL & " UNION ALL SELECT * FROM [" & arrSheets(i) & "$]"
            End If
        End If
    Next i
    
    strCon = _
        "ODBC;" & _
        "DSN=Excel Files;" & _
        "DBQ=" & strFileTemp & ";" & _
        "DefaultDir=" & strPath & ";" & _
        "DriverId=790;" & _
        "MaxBufferSize=2048;" & _
        "PageTimeout=5"
    
    Set PC = ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)
    
    With PC
        .Connection = strCon
        .CommandType = xlCmdSql
        .CommandText = strSQL
        Set PT = .CreatePivotTable(TableDestination:=ActiveSheet.Range("A7"))
        PT.Name = "TestPivot"
    End With
        
    With PT.PivotCache
        .Connection = Replace(strCon, strFileTemp, strFile)
    End With
    
    'Clean up
    Kill strFileTemp
    Set PT = Nothing
    Set PC = Nothing
    
End Sub

Sub ReestablishConnection_client()
    Dim strFile As String
    Dim strPath As String
    Dim strCon As String
    
    With ThisWorkbook
        strPath = .Path
        strFile = .FullName
        
        strCon = _
            "ODBC;" & _
            "DSN=Excel Files;" & _
            "DBQ=" & strFile & ";" & _
            "DefaultDir=" & strPath & ";" & _
            "DriverId=790;" & _
            "MaxBufferSize=2048;" & _
            "PageTimeout=5"
        
       ' With .Worksheets("clients$")
       '     If .PivotTables.Count > 0 Then .PivotTables(PIVOTNAME).PivotCache.Connection = strCon
       ' End With
    End With
      
    
End Sub

Private Sub DeleteConnections_client()
    Dim con
    Dim PT As PivotTable
   '   This line won't work and wouldn't be necessary
   '   in the versions older than 2007
    '*****************************************************************************
   On Error Resume Next
    With ThisWorkbook
         Set PT = .Worksheets("client$").PivotTables(PIVOTNAME)
         For Each con In .Connections
         If con.ODBCConnection.Connection = PT.PivotCache.Connection _
         And con.ODBCConnection.CommandText = PT.PivotCache.CommandText Then
         con.Delete
     End If
     Next con
   End With
   On Error GoTo 0
'*****************************************************************************
End Sub

Sub CheckFileFormat_client()
    With ThisWorkbook
        Select Case .FileFormat
        Case 51: strFileExt = ".xlsx": lngFileFormat = 51
        Case 52:
            If .HasVBProject Then
                strFileExt = ".xlsm": lngFileFormat = 52
            Else
                strFileExt = ".xlsx": lngFileFormat = 51
            End If
        Case 56: strFileExt = ".xls": lngFileFormat = 56
        Case Else: strFileExt = ".xlsb": lngFileFormat = 50
        End Select
    End With
End Sub

Sub SamplePivot_client()
    Dim PT As PivotTable
    
    CreateConnection_client
    Set PT = ThisWorkbook.Worksheets("clients$").PivotTables(PIVOTNAME)
    
    With PT
        With .PivotFields(3)                                      'client         nom des lignes
            .Orientation = xlRowField
            .Position = 1
        End With
       .AddDataField .PivotFields(9), "Valeur CDN $", xlSum     'Total CDN     Valeur à calculer
       .AddDataField .PivotFields(4), "Nbre ventes", xlCount     'nbre de ventes   valeur à calculer
        'mise en forme monétaire et nombre
        PT.PivotFields("valeur CDN $").NumberFormat = "#,##0.00 $"
        PT.PivotFields("Nbre ventes").NumberFormat = "#,###"
       
        
        With .PivotFields(1)                                       'type ventes   champs pour faire un trie
            .Orientation = xlPageField
            .Position = 1
        End With
        With .PivotFields(15)                                       'Année         nom des colonnes
            .Orientation = xlColumnField
            .Position = 1
           ' code pour extraire le mois et l'année d'une date
           ' .DataRange.Cells(1).Group _
            '    Start:=True, _
             '   End:=True, _
              '  Periods:=Array(False, False, False, False, True, False, True)
        End With
    End With
        
        
    'Clean up
    Set PT = Nothing
    Application.ScreenUpdating = True


'formater colonne et ligne et masquer blank client


  ' enlève la colonne grand total qui s'inclut automatiquement dans le tableau
   Range("A8").Select
    With ActiveSheet.PivotTables("TestPivot").PivotFields("Année")
        .PivotItems("(blank)").Visible = False
    End With
    
    ' enlève la ligne blank des clients
   Range("A8").Select
    With ActiveSheet.PivotTables("TestPivot").PivotFields("client")
        .PivotItems("(blank)").Visible = False
    End With
    
    ActiveSheet.PivotTables("TestPivot").TableStyle2 = "PivotTable Style 1"
    Range("A1").Select
    Sheets("clients$").Select
    ActiveCell.FormulaR1C1 = "Analyse des ventes par clients"
    Range("A1:G1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 6692904
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.Font.Bold = True
    Range("E5").Select

   
   
' mise en forme couleur 1 ligne sur 2
'Dim cellule As Range
'A10 est la cellule à partir de laquel je veux que les lignes se colore 1 / 2
' Range("A10:G" & Range("A65536").End(xlUp).Row).Select
' For Each cellule In Selection
' If cellule.Row Mod 2 = 0 Then
'         With cellule
'         .Interior.ColorIndex = 47
' End With
'    Else: With cellule
'         .Interior.ColorIndex = xlNone
'       End With
'   End If
' Next
 
 
 Dim i As Long
Application.ScreenUpdating = False
For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
'          2 = la colonne B                                  7 la colonne G
If Cells(i, 2) = "Valeur CDN $" Then Range(Cells(i, 2), Cells(i, 7)).Interior.ColorIndex = 0
If Cells(i, 2) = "Nbre ventes" Then Range(Cells(i, 1), Cells(i, 7)).Interior.ColorIndex = 47
Next i

End Sub

 

[bouclesdor]

Re : Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

personne???

dans ce cas, je vais continuer à chercher de mon côté....

bonne journée,

 

[tototiti2008]

Re : Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

Bonjour bouclesdor,

Je pense que le problème vient de ta chaine de connexion

    strCon = _
        "ODBC;" & _
        "DSN=Excel Files;" & _
        "DBQ=" & strFileTemp & ";" & _
        "DefaultDir=" & strPath & ";" & _
        "DriverId=790;" & _
        "MaxBufferSize=2048;" & _
        "PageTimeout=5"

Le problème c'est que tu as une connexion ODBC vers un fichier Excel externe, et que nous ne savons pas où il est censé être sur ton poste ni ce qu'il contient comme données
Tu nous dit : il n'arrive pas à se connecter à la source mais as-tu vérifié ta source ?
A-t-elle le nom prévu par la macro, est-elle placée au bon endroit, contient-elle les bonne données... etc..
tout ça, tu es la seule à pouvoir le contrôler

 

[bouclesdor]

Re : Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

Merci Tototiti2008!

Mon gros problème est que je ne sais pas ce que veux dire ce bout de code ( j'ai trouvé ce code sur internet et je l'ai adapté au meilleur de ma connaissance. ) alors mon petit doigt me dit que mon problème vient de la connection à la source ou quelque chose du genre... mais je ne sais pas comment résoudre mon problème.

Mais avec tes questions tototiti2008 je vais essayer de trouver l'origine de mon problème!

Merci encore de ton aide je vous reviens si je trouve une solution.

Bouclesdor

 

[tototiti2008]

Re : Tableau dynamique croisée créé à partir de Codes VBA - code d'erreur

Bonjour bouclesdor,

Non, finalement en testant mieux tes macros, il semble bien qu'elles fonctionnent chez moi.... donc pas d'idée