Mise à jour liaisons TCD Excel 2003 avec données externes Access 9

Voici une procédure !

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

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
Dim vCmd As Variant
'***************************************************
'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:Comptoirssss.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:Comptoirssss" '<<========== 'Nouveau chemin complet + nom de la base de donnée SANS l'EXTENSION
NewWay = "c:AAAComptoir" '<<========== '*****************************************

For Each Sh In ActiveWorkbook.WorkSheets
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)
'Utiliser cette ligne de code dans les cas où la chaîne
'de la requête dépasse 255 caractères
If Len(NewQuery) <%5 then
Pt.PivotCache.CommandText = NewQuery
Else
Pt.PivotCache.CommandText = StringToArray(NewQuery)
End if
'Mise à jour de la nouvelle information
Pt.PivotCache.Refresh
Next Pt
Next Sh
End Sub
'---------------------------------------------------------------

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
'---------------------------





"Eddie les bons tuyaux" <Eddielesbonstuyaux@discussions.microsoft.com> a
écrit dans le message de news:
5685DC56-D910-4BAB-82D8-2276C1B19662@microsoft.com...
Bonjour,
J'ai créé, sur un ordinateur-source un TCD sous Excel 2003, basé sur une
base de données Access 2007.
Puis, j'ai recopié ces 2 éléments sur un autre ordinateur, dans une
arborescence de répertoire différente de celle existant sur l'ordinateur
d'origine.
Comment faire pour rectifier la liaison entre mon TDC et mon fichier Access
pour l'adapter au contexte de l'ordinateur destination ?

Merci d'avance de votre aide.