automatiser la mise à jour de la source ext. d'un TCD

GENIAL !!!!!!

Voila une affaire qui me parait résolue.....
Ca semble marcher parfaitement sur un exemple simple (2 TCD et toute
petite BDD associée)

Je n'ai plus qu'à transferer sur mon fichier avec les 17 TCD (!!!)

Je te donnerai des nouvelles et viendrait déposer le script final....
(Si ca peut servir...)

Encore Mille Merci !!!

Michel

Encore moi.....

J'ai un souci qui me fait tourner en bourrique....
Tout semble parfait..... Sauf que j'ai un plantage systématique (erreur
d'execution 1004 définie par l'application ou par l'objet) à la ligne
qui doit réintégrer la NexQuery dans le commandTest de mon TCD

J'ai fait une petite expérience. Qqs lignes au dessus, je lis le
OldQuery du commandtext de mon TCD :
(oldQuery = Pt.PivotCache.CommandText)

J'ai ajouté la ligne suivante pour réattribuer immédiatement le Olquery
à mon commandtext sans modification:
(Pt.PivotCache.CommandText = oldQuery)


Résultat, J'ai le même message d'erreur

Une précision, la table Access qui sert de source à mon TCD possède un
assez grand nombre de champs.
Du coup la chaine atteint 524 caractères...

Je me demandais si ca ne pouvait être une source de plantage????


En attendant voici le code que j'ai appliqué (adapté du tien pour coller
à mes données d'exemple
Suit également la chaine CommandText de mon TCD (Oldquery & NewQuery)

****************************************************
Sub ChangerCheminFichierSource_Pour_TDC()

Dim Sh As Worksheet, Pt As PivotTable
Dim OldConn As String, OldRepertoreParDefaut As String
Dim OldCheminComplet As String, NewRepParDefaut As String
Dim NewCheminComplet As String, NewConn As String

Dim oldQuery As String, OldWay As String
Dim NewWay As String, NewQuery As String

'***************************************************
'Variable à renseigner pour modifier la connection
'Répertoire par défaut du fichier .mdb lors de la connection
'OldRepertoreParDefaut = "DefaultDir=C:"
OldRepertoreParDefaut = "DefaultDir=C:tempTCDBDDDossier01"

'Nouveau répertoire par défaut
'NewRepParDefaut = "DefaultDir=C:AAA"
NewRepParDefaut = "DefaultDir=C:tempTCDBDDDossier02"

'Chemin complet + nom base de donnée + extention
'OldCheminComplet = "DBQ=C:Comptoir.mdb"
OldCheminComplet = "DBQ=C:tempTCDBDDDossier01BDD01.mdb"

'Nouveau Chemin complet + nom base de donnée + extension
'NewCheminComplet = "DBQ=C:AAAComptoir.mdb"
NewCheminComplet = "DBQ=C:tempTCDBDDDossier02BDD02.mdb"

'DefaultDir et DBQ ont été incluses dans la chaîne afin
'd'éviter toute confusion possible lors de la substituion
'***************************************************

'Variable à renseigner pour modifier la requête
'ou propriété : CommandText du PivotCache
'Ancien chemin complet de la base de donnée SANS L'EXTENSION
OldWay = "C:tempTCDBDDDossier01BDD01" '<<========== 'Nouveau chemin complet + nom de la base de donnée SANS l'EXTENSION
NewWay = "C:tempTCDBDDDossier02BDD02" '<<========== '*****************************************

'For Each Sh In ActiveWorkbook.Sheets
'For Each Pt In Sh.PivotTables

'Plutot que boucler sur tous les TCD, je limite la modification
'au 1er, tous les autres étants liés à lui pour leur source
Set Pt = ActiveWorkbook.ActiveSheet.PivotTables("TCD_Maitre")
'Récupérée l'ancienne connection
OldConn = Pt.PivotCache.Connection
'Substitution pour la nouvelle localisation
'La fonction Replace existe depuis Excel 2002
'Si pas disponible utiliser : Application.Substitute()
NewConn = Replace(OldConn, OldRepertoreParDefaut, _
NewRepParDefaut, 1, , vbTextCompare)
NewConn = Replace(NewConn, OldCheminComplet, _
NewCheminComplet, 1, , vbTextCompare)
Pt.PivotCache.Connection = NewConn

'Modifier la requête
'Extraire la chaîne de la requête
oldQuery = Pt.PivotCache.CommandText
'A supprimer, ajouter pour débogage
'Pt.PivotCache.CommandText = oldQuery
'Range("C32") = oldQuery

'Substitution
NewQuery = Replace(oldQuery, OldWay, NewWay, 1, , vbTextCompare)
'A supprimer, ajouter pour débogage
'Range("C33") = NewQuery
Pt.PivotCache.CommandText = NewQuery
'Mise à jour de la nouvelle information
Pt.PivotCache.Refresh

'Next Pt
'Next Sh
End Sub

**************************************************
###### OldConn##########
ODBC;DSN=MS Access
Database;DBQ=C:tempTCDBDDDossier01BDD01.mdb;DefaultDir=C:tempTCDBDDDossier01;DriverId%;FIL=MS
Access;MaxBufferSize 48;PageTimeout=5;
#########################

###### NewConn##########
ODBC;DSN=MS Access
Database;DBQ=C:tempTCDBDDDossier02BDD02.mdb;DefaultDir=C:tempTCDBDDDossier02;DriverId%;FIL=MS
Access;MaxBufferSize 48;PageTimeout=5;
#########################


###### OldQuery##########
"SELECT BDD.Numéro1, BDD.Numéro, BDD.`Code ACP`, BDD.Région, BDD.Point,
BDD.Bassin, BDD.Age, BDD.Campagne, BDD.Opération, BDD.`poids moyen`,
BDD.`IC95%`, BDD.morts, BDD.vivants, BDD.enlevés, BDD.trouvés,
BDD.remis, BDD.`Durée (j)`, BDD.Mortalité, BDD.`IC 95%`, BDD.Pds_coq,
BDD.Pds_coq_IC95, BDD.Coef_ep, BDD.Coef_ep_IC95, BDD.Gelatine,
BDD.GelatineIC95, BDD.Polydora, BDD.Polydora_IC95, BDD.Ind_chair,
BDD.Ind_chair_IC95, BDD.Tx_chair_sec, BDD.Tx_chair_sec_IC95, BDD.Maturite
FROM `C:tempTCDBDDDossier01BDD01`.BDD BDD"
#########################


###### NewQuery##########
"SELECT BDD.Numéro1, BDD.Numéro, BDD.`Code ACP`, BDD.Région, BDD.Point,
BDD.Bassin, BDD.Age, BDD.Campagne, BDD.Opération, BDD.`poids moyen`,
BDD.`IC95%`, BDD.morts, BDD.vivants, BDD.enlevés, BDD.trouvés,
BDD.remis, BDD.`Durée (j)`, BDD.Mortalité, BDD.`IC 95%`, BDD.Pds_coq,
BDD.Pds_coq_IC95, BDD.Coef_ep, BDD.Coef_ep_IC95, BDD.Gelatine,
BDD.GelatineIC95, BDD.Polydora, BDD.Polydora_IC95, BDD.Ind_chair,
BDD.Ind_chair_IC95, BDD.Tx_chair_sec, BDD.Tx_chair_sec_IC95, BDD.Maturite
FROM `C:tempTCDBDDDossier02BDD02`.BDD BDD"
#########################




MichDenis a écrit :

Après un petit test, la modification de la source de donnée
pour un TDC est semblable à la modification de la source
pour un QueryTable. De fait, il n'y a que l'objet qui est différent.

TDC = PivotTable.PivotCache
QueryTable = QueryTable

En supposant que tu modifies le chemin où se trouve la base de donnée .MDB
Tu dois modifier 2 choses
a ) La chaîne de connection du PivotCache : Connection
b ) La chaîne de connection dde la requête : CommandText

Voici ce que donne la procédure soumise hier à cet égat

P.S- Il faut être parcimonieux sur la syntaxe que l'on veut modifier

'J'ai fait un tout petit test et cela fonctionne très bien!
'---------------------------------------------------------
Sub ChangerCheminFichierSource_Pour_TDC()

Dim Sh As Worksheet, Pt As PivotTable
Dim OldConn As String, OldRepertoreParDefaut As String
Dim OldCheminComplet As String, NewRepParDefaut As String
Dim NewCheminComplet As String, NewConn As String

Dim oldQuery As String, OldWay As String
Dim NewWay As String, NewQuery As String

'***************************************************
'Variable à renseigner pour modifier la connection
'Répertoire par défaut du fichier .mdb lors de la connection
OldRepertoreParDefaut = "DefaultDir=C:"
'Chemin complet + nom base de donnée + extention
OldCheminComplet = "DBQ=C:Comptoir.mdb"
'Nouveau répertoire par défaut
NewRepParDefaut = "DefaultDir=C:AAA"
'Nouveau Chemin complet + nom base de donnée + extension
NewCheminComplet = "DBQ=C:AAAComptoir.mdb"
'DefaultDir et DBQ ont été incluses dans la chaîne afin
'd'éviter toute confusion possible lors de la substituion
'***************************************************

'Variable à renseigner pour modifier la requête
'ou propriété : CommandText du PivotCache
'Ancien chemin complet de la base de donnée SANS L'EXTENSION
OldWay = "C:Comptoir" '<<========== > 'Nouveau chemin complet + nom de la base de donnée SANS l'EXTENSION
NewWay = "c:AAAComptoir" '<<========== > '*****************************************

For Each Sh In ActiveWorkbook.Sheets
For Each Pt In Sh.PivotTables
'Récupérée l'ancienne connection
OldConn = Pt.PivotCache.Connection
'Substitution pour la nouvelle localisation
'La fonction Replace existe depuis Excel 2002
'Si pas disponible utiliser : Application.Substitute()
NewConn = Replace(OldConn, OldRepertoreParDefaut, _
NewRepParDefaut, 1, , vbTextCompare)
NewConn = Replace(NewConn, OldCheminComplet, _
NewCheminComplet, 1, , vbTextCompare)
Pt.PivotCache.Connection = NewConn

'Modifier la requête
'Extraire la chaîne de la requête
oldQuery = Pt.PivotCache.CommandText
'Substitution
NewQuery = Replace(oldQuery, OldWay, NewWay, 1, , vbTextCompare)
Pt.PivotCache.CommandText = NewQuery
'Mise à jour de la nouvelle information
Pt.PivotCache.Refresh
Next Pt
Next Sh
End Sub
'---------------------------------------------------------------


"michel" <mropert@ifremer.fr> a écrit dans le message de news: uu1QIN21IHA.524@TK2MSFTNGP05.phx.gbl...
Bonjour MichDenis.....

En effet c'est sur cette piste que j'ai du arrêter hier soir....

Ce matin, j'ai (enfin !) compris comment selectionner en VBA mon TCD (en
nommant "TCD1" la première cellule du TCD en haut à gauche)

Ensuite j'ai appliqué cette petite routine (adapté de l'aide VBA d'Excel
à la page "SourceData"):
***************
Sub Test()
'ActiveSheet.Range("TCD1").Select
sdArray = Worksheets("TCD").Range("TCD1").PivotTable.SourceData
Set NewSheet = ActiveWorkbook.Worksheets.Add
For I = LBound(sdArray) To UBound(sdArray)
NewSheet.Cells(I, 1) = sdArray(I)
Next I
End Sub
****************

Elle me colle les chaines suivantes :

DSN=MS Access Database;DBQ=M:REMORAsynth
Pluri-annuelle(SMEL)LoïcBDDBDD_REMONOR_BV02.mdb;DefaultDir=M:REMORAsynth
Pluri-annuelle (SMEL)LoïcBDD;DriverId%;FIL=MS
Access;MaxBufferSize 48;PageTimeout=5;

SELECT BDD.Numéro, BDD.`Code ACP`, BDD.Région, BDD.Point, BDD.Bassin,
BDD.Age, BDD.Campagne, BDD.Opération, BDD.`poids moyen`, BDD.`IC95%`,
BDD.morts, BDD.vivants, BDD.enlevés, BDD.trouvés, BDD.remis, BDD.`Durée
(j)`, BDD.Mortalité, BDD.`IC 95%`, BDD.Pds_coq, BDD.Pds_coq_IC95,
BDD.Coef_ep, BDD.Coef_ep_IC95, BDD.Gelatine, BDD.GelatineIC95,
BDD.Polydora, BDD.Polydora_IC95, BDD.Ind_chair, BDD.Ind_chair_IC95,
BDD.Tx_chair_sec, BDD.Tx_chair_sec_IC95, BDD.Maturite, BDD.s_ColLineage,
BDD.s_Generation, BDD.s_GUID, BDD.s_Lineage
FROM `M:REMORAsynth Pluri-annuelle SMEL)LoïcBDDBDD_REMONOR_BV02`.BD"
D BDD




J'ai ensuite appliqué la routine que tu m'as envoyé...
Le résultat semble convainquant :

ODBC;DSN=MS Access Database;DBQ=M:REMORAsynth Pluri-annuelle
(SMEL)LoïcBDDBDD_REMONOR_BV02.mdb;DefaultDir=M:REMORAsynth
Pluri-annuelle (SMEL)LoïcBDD;DriverId%;FIL=MS
Access;MaxBufferSize 48;PageTimeout=5;



Je pense que je suis donc sur la BONNE VOIE....



Encore mille merci pour tous ces conseils !

Michel



MichDenis a écrit :

La procédure soumise boucle sur les PivotCaches()
et non sur les TDC.

Si tous les TDC de ton application utilise le même PivotCache
Alors il n'y a qu'une modification à faire.

Le PivotCache c'est l'antémémoire des TDC !

As-tu essayé d'insérer le contenu (c'est une chaîne de caractères)
de la connection dans une cellule. Si ça fait plusieurs procédures
que tu as utilisées pour triturer cette chaîne de connection, elle
a probablement perdu de la fraîcheur...;-) ça te permettrait de voir
si ce que tu tentes de remplacer existe vraiment dans la chaîne de
connection :

Pour ce faire :

Sub ChangeServer()

Dim sh As Worksheet, qy As QueryTable
Dim pt As PivotTable, pc As PivotCache
Dim OldPath As String, NewPath As String
Dim strOld As String, strNew As String

' Replace the following paths with the original path or
' server name where your database resided, and the new
' path or server name where your database now resides.

OldPath = "<old server name>"
NewPath = "<new server name>"
For Each sh In ActiveWorkbook.Sheets
For Each pt In sh.PivotTables
strOld = pt.PivotCache.Connection
'-------------------
A = A+1
RAnge("A" & A ) = strOld
'-------------------
'strNew = Replace(strOld, OldPath, NewPath)
' pt.PivotCache.Connection = strNew
' pt.PivotCache.Refresh
Next pt
Next sh
End Sub


"michel" <mropert@ifremer.fr> a écrit dans le message de news: OIyNN8t1IHA.5728@TK2MSFTNGP06.phx.gbl...
Le code s'intègre très bien dans ma macro (pas de plantage)

Mais le résultat ne semble pas là..... la mise à jour ne parait pas se
faire......

Mais tu as peut être vu qu'en dessous le fil se poursuit et qu'à priori,
je n'ai plus qu'1 seul TCD sur les 16 à modifier (les 15 autres sont
relié au premier...)

merci...

M.


MichDenis a écrit :

As-tu essayé ceci, proposé par Microsoft :

http://support.microsoft.com/kb/327572

'------------------------------------
Sub ChangeServer()

Dim sh As Worksheet, qy As QueryTable
Dim pt As PivotTable, pc As PivotCache
Dim OldPath As String, NewPath As String
Dim strOld As String, strNew As String

' Replace the following paths with the original path or
' server name where your database resided, and the new
' path or server name where your database now resides.

OldPath = "<old server name>"
NewPath = "<new server name>"
For Each sh In ActiveWorkbook.Sheets
For Each pt In sh.PivotTables
strOld = pt.PivotCache.Connection
strNew = Replace(strOld, OldPath, NewPath)
pt.PivotCache.Connection = strNew
pt.PivotCache.Refresh
Next pt
Next sh
End Sub
'------------------------------------




"michel" <mropert@ifremer.fr> a écrit dans le message de news: %236hpjYs1IHA.2384@TK2MSFTNGP04.phx.gbl...
Bonjour à tous....

Un peu las de tourner en rond depuis de nombreuses heures, et après
avoir longuement étudié la page d'EXCELABO dédié à cette question
(Changer la source (lien ODBC) d'un tableau croisé dynamique), je me
tourne vers vous...
Voici mon prb.

Sur différentes feuilles d'un fichier EXCEL, je trouve plusieurs TCD
(nombre variable selon les feuilles) qui tous sont liés à une même table
ACCESS située soit dans le même dossier que le fichier XLS soit dans un
dossier "fils".

Ce fichier (et la table associée) sont destinés à être utilisés sur
différents postes de travail, et, selon toute probabilité, à être
utilisés en copie locale sur chaque Poste.
Ca implique qu'à chaque copie du Fichier et de sa table associée, on
redéfinisse la source de tous les TCD en fonction du nouvelle
emplacement....

La solution manuelle, appliquée à 1 TCD, trouvée sur Excelabo
(http://www.excelabo.net/excel/tcddiv.php#sourcetcd) fonctionne très bien.

Mon objectif serait de pouvoir automatiser la chose pour chaque TCD de
toutes mes feuilles pour que ce soit transparent pour l'utilisateur....

Actuellement j'en suis là :

---------------------------------------------
Sub Mise_à_jours_lient_BDD()
'
Dim Dlg As FileDialog
Dim I As Integer, J As Integer
Dim Feuille As Worksheet

'Récupération du chemin complet de la table ACCESS par l'utilisateur
Set Dlg = Application.FileDialog(msoFileDialogFilePicker)
Dlg.Show
NomBDD = Dlg.SelectedItems(1)

'extraction du chemin de dossier seul contenant la table Access
For I = Len(NomBDD) To 1 Step -1
If Mid$(NomBDD, I, 1) = "" Then Exit For
Next
CheminBDD = Left$(NomBDD, I - 1)

'pour chaque feuille du fichier
For Each Feuille In Worksheets

'si le nom de la feuille commence par TCD
If UCase(Left(Feuille.Name, 4)) = "TCD_" Then
For J = Feuille.PivotTables.Count To 1 Step -1
'#
'# C'est là que je voudrais trouver le moyen
'# de définir le chemin de ma source à partir
'# des variables NomBDD et CheminBDD
Next J
End If
Next Feuille

End Sub
-------------------------------------------

En mode d'enregistrement automatique de macro, la méthode Excelabo donne
cela en VB (après avoir selectionné une cellule du TCD dont la source
est à mettre à jour) :

ActiveSheet.PivotTableWizard SourceType:=xlExternal,
SourceData:=Array( _
"SELECT BDD.Numéro, BDD.`Code ACP`, BDD.Région, BDD.Point,
BDD.Bassin, BDD.Age, BDD.Campagne, BDD.Opération, BDD.`poids moyen`,
BDD.`IC95%`, BDD.morts, BDD.vivants, BDD.enlevés, BDD.trouvés, BDD.remis," _
, _
" BDD.`Durée (j)`, BDD.Mortalité, BDD.`IC 95%`, BDD.Pds_coq,
BDD.Pds_coq_IC95, BDD.Coef_ep, BDD.Coef_ep_IC95, BDD.Gelatine,
BDD.GelatineIC95, BDD.Polydora, BDD.Polydora_IC95, BDD.Ind_chair,
BDD.Ind_cha" _
, _
"ir_IC95, BDD.Tx_chair_sec, BDD.Tx_chair_sec_IC95,
BDD.Maturite, BDD.s_ColLineage, BDD.s_Generation, BDD.s_GUID,
BDD.s_Lineage" & Chr(13) & "" & Chr(10) & "FROM BDD BDD" _
), Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=C:Documents and
SettingsxxxBDDBDD_REMONOR.mdb;DefaultDir=C:Documents and
SettingsxxxBDD;DriverId%;FIL=MS
Access;MaxBufferSize 48;PageTimeout=5;UID­min;" _
))


(Je ne sais pas si c'est très compréhensible.....)


BREF, voilà les éléments en ma possession (qui restent pour moi assez
obscures), mais si parmi vous ca semble limpide (on ne sait jamais),
alors vous aurez par avance tous mes remerciements pour les conseils...

Merci..

Michel

Pour faire suite à mon mail de 10:34,
je viens de réaliser que ton dernier code fonctionne tres bien s'il n'y
a qu'un seul TCD sur la feuille.
Dès qu'un 2nd est présent, il y a erreur sur
"Pt.PivotCache.CommandText = NewQuery"

M.

Je vais tester de mon côté...... et suivre ton conseil en allant
chercher sur Internet.... (Pour ce qui est de renvoyer le logiciel de
merde, je crains que cette solution ne soit pas d'une grande efficacité...)

Reste un mystère concernant le fait que le Bug n'aparait QUE s'il y a
plus d'un TCD dans mon fichier.....

Conclusion, tous ces efforts depuis 3 jours pour.... rien (?)

Vraiment désolé d'avoir abusé comme ca de ton temps...
encore merci malgré tout...

Cordialement

M.

MichDenis a écrit :

| Pt.PivotCache.CommandText = NewQuery

Ceci génère une erreur seulement si NewQuery représente une chaîne
de 255 caractères. C'est un autre BUG bien connu de Microsoft.

Si tu fais une recherche sur internet, tu trouveras au moins ces 2 fonctions
supposés apporté un correctif (test non concluant)

Ta ligne de code deviendrait alors :
Pt.PivotCache.CommandText = SplitString(NewQuery)
OU
Pt.PivotCache.CommandText = StringToArray(NewQuery)
Selon la fonction que tu décides d'utiliser

Aucune ne m'a donné satisfaction.

Tu ouvres internet et tu fais plus de recherche ou tu
retourne ton logiciel de merde à Microsoft

'---------------------------
Public Function SplitString(ByVal strCommandText As String) As Variant
Dim varCommandText() As Variant
Dim i As Long

ReDim varCommandText(0 To Len(strCommandText) 255) ' note: it is not 256
For i = 0 To UBound(varCommandText)
varCommandText(i) = Mid(strCommandText, i * 255 + 1, 255)
Next
SplitString = varCommandText
End Function

'---------------------------
Public Function StringToArray(Query As String) As Variant
Const StrLen = 127
Dim NumElems As Integer
Dim Temp() As String
Dim i As Integer

On Error GoTo Err_handle

NumElems = (Len(Query) / StrLen) + 1
ReDim Temp(1 To NumElems) As String
For i = 1 To NumElems
Temp(i) = Mid(Query, ((i - 1) * StrLen) + 1, StrLen)
Next i
StringToArray = Temp
Exit Function
Err_handle:
MsgBox "error"
Resume
End Function
'---------------------------



"michel" <mropert@ifremer.fr> a écrit dans le message de news: uqRWvSE2IHA.4164@TK2MSFTNGP03.phx.gbl...
Pour faire suite à mon mail de 10:34,
je viens de réaliser que ton dernier code fonctionne tres bien s'il n'y
a qu'un seul TCD sur la feuille.
Dès qu'un 2nd est présent, il y a erreur sur
"Pt.PivotCache.CommandText = NewQuery"

M.