2010-12-09 25 views

Répondre

2

Je l'ai écrit récemment. Cela pourrait marcher pour vous. Il tente de copier le cache pivot et/ou les données de table de requête pour le classeur actif dans le Presse-papiers. Il est entouré de On Resume Resume Next, donc s'il ne trouve pas un élément de données particulier, il continue:

Sub Copy_Connection_Info_To_Clipboard() 

Dim ptCache As Excel.PivotCache 
Dim qtQueryTable As Excel.QueryTable 
Dim strPtCacheInfo As String 
Dim strQueryTableInfo As String 
Dim ws As Excel.Worksheet 
Dim strConnectionInfo As String 
Dim doConnectionInfo As DataObject 

On Error Resume Next 
For Each ptCache In ActiveWorkbook.PivotCaches 
    With ptCache 
     strPtCacheInfo = _ 
     strPtCacheInfo _ 
     & "PivotCache #" & "Index: " & .Index & vbCrLf & vbCrLf _ 
         & "SourceDataFile: " & .SourceDataFile & vbCrLf & vbCrLf _ 
         & "CommandText: " & .CommandText & vbCrLf & vbCrLf _ 
         & "SourceConnectionFile: " & .SourceConnectionFile & vbCrLf & vbCrLf _ 
         & "Connection: " & .Connection & vbCrLf & vbCrLf 
    End With 
Next ptCache 
If strPtCacheInfo <> "" Then 
    strPtCacheInfo = "PivotCache Info" & vbCrLf & vbCrLf & strPtCacheInfo 
End If 

For Each ws In ActiveWorkbook.Worksheets 
    If ws.QueryTables.Count > 0 Then 
     strQueryTableInfo = "Worksheet: " & ws.Name & vbCrLf 
     For Each qtQueryTable In ActiveSheet.QueryTables 
      With qtQueryTable 
       strQueryTableInfo = _ 
       strQueryTableInfo _ 
       & "QueryTable Name: " & .Name & vbCrLf & vbCrLf _ 
       & .SourceDataFile & vbCrLf & vbCrLf _ 
       & .CommandText & vbCrLf & vbCrLf _ 
       & .SourceConnectionFile & vbCrLf & vbCrLf _ 
       & .Connection & vbCrLf & vbCrLf 
      End With 
     Next qtQueryTable 
    End If 
Next ws 
If strQueryTableInfo <> "" Then 
    strQueryTableInfo = "Query Table Info" & vbCrLf & strQueryTableInfo 
End If 

strConnectionInfo = strPtCacheInfo & strQueryTableInfo 
If strConnectionInfo <> "" Then 
    Set doConnectionInfo = New DataObject 
    doConnectionInfo.SetText strConnectionInfo 
    doConnectionInfo.PutInClipboard 
End If 

End Sub 
+0

Merci! ça a marché :) – ichigo