Message erreur Excel

Bonjour Patrice,

C'est la première fois que je demande de l'aide à un forum, donc je crois que je t'ai pas remis mon résumé au bon endroit. Le voici à nouveau au cas où!
Bonjour Patrice,

Voici un résumé:
Lorsque je lance ma macro elle m'indique le message d'erreur suivant:

Erreur d'excécution 1004;
Microsoft Gestionnaire de pilotes ODBC Source de données introuvable et nom de pilote non spécifié.

Lorsque je le débogue voici l'endroit au c'est surligner en jaune dans la macro: Je l'ai mis en rouge dans le courriel pour une meilleur visualisation:

J'ai aucune idée de se qui pourrais ce produire ???

Par contre toutes mes feuilles Excel dans laquelle les employés sont correct. C'est à dire lorsque je lance ma macro individuellement par employé mon résultat affiche. J'ai le bogue seulement lorsque je lance la macro avec toutes les feuilles Excel des employés en même temps.



___________________________________________________

Option Explicit

Declare Function SetCurrentDirectoryA Lib "kernel32" (ByVal Path As String) As Long
Sub ChDirNet(Path As String)
Dim Result As Long
Result = SetCurrentDirectoryA(Path)
If Result = 0 Then Err.Raise vbObjectError + 1, "Error changing to new path."
End Sub

Sub MergeFiles()
Dim PT As PivotTable
Dim PC As PivotCache
Dim arrFiles As Variant
Dim strSheet As String
Dim strPath As String
Dim strSQL As String
Dim strCon As String
Dim rng As Range
Dim i As Long

strPath = CurDir
ChDirNet ThisWorkbook.Path

arrFiles = Application.GetOpenFilename("Excel Workbooks (*.xls), *.xls", , , , True)
strSheet = "Sheet1"

If Not IsArray(arrFiles) Then Exit Sub

Application.ScreenUpdating = False

If Val(Application.Version) > 11 Then DeleteConnections_12

Set rng = ThisWorkbook.Sheets(1).Cells
rng.Clear
For i = 1 To UBound(arrFiles)
If strSQL = "" Then
strSQL = "SELECT * FROM [" & strSheet & "$]"
Else
strSQL = strSQL & " UNION ALL SELECT * FROM '" & arrFiles(i) & "'.[" & strSheet & "$]"
End If
Next i
strCon = _
"ODBC;" & _
"DSN=Excel Files;" & _
"DBQ=" & arrFiles(1) & ";" & _
"DefaultDir=" & "" & ";" & _
"DriverId=790;" & _
"MaxBufferSize=2048;" & _
"PageTimeout=5"

Set PC = ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)

'*************************** Global pivot table *****************************
With PC
.Connection = strCon
.CommandType = xlCmdSql
.CommandText = strSQL
Set PT = .CreatePivotTable(TableDestination:=rng(6, 1))
End With

With PT
With .PivotFields(1) 'Exercice
.Orientation = xlPageField
.Position = 1
End With
.AddDataField .PivotFields(3), "Dossier", xlCount
.AddDataField .PivotFields(9), "Op. sous-éval.", xlCount
.AddDataField .PivotFields(10), "Transf. fin. inadéquat", xlCount
.AddDataField .PivotFields(11), "Défaut registres", xlCount
.AddDataField .PivotFields(12), "Défaut bilan", xlCount
.AddDataField .PivotFields(13), "Fausse décl.", xlCount
.AddDataField .PivotFields(14), "Défaut interro.", xlCount
.AddDataField .PivotFields(15), "Défaut assemblées", xlCount
.AddDataField .PivotFields(16), "Défaut contultation", xlCount
.AddDataField .PivotFields(17), "Défaut rev. excédent.", xlCount
.AddDataField .PivotFields(18), "Abus système", xlCount
.AddDataField .PivotFields(19), "Emprunt irr.", xlCount
.AddDataField .PivotFields(20), "Conduite adm.", xlCount
.AddDataField .PivotFields(21), "Fermé sans interro.", xlCount
.AddDataField .PivotFields(22), "Interro.", xlCount
.AddDataField .PivotFields(24), "Intervention BSF", xlCount
.AddDataField .PivotFields(26), "Mandat BSF", xlCount
With .PivotFields(6) 'Analyste
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields(2) 'Date renvoi
.Orientation = xlRowField
.Position = 1
.DataRange.Cells(1).Group _
Start:=True, _
End:=True, _
Periods:=Array(False, False, False, False, True, False, True)
End With
End With

'*************************** Intervention pivot table *****************************
Set rng = ThisWorkbook.Sheets(2).Cells
rng.Clear
With PC
Set PT = .CreatePivotTable(TableDestination:=rng(6, 1))
End With
With PT
With .PivotFields(1) 'Exercice
.Orientation = xlPageField
.Position = 1
End With
.AddDataField .PivotFields(24), "Intervention BSF", xlCount
With .PivotFields(25) 'Date intervention
.Orientation = xlColumnField
.Position = 1
.DataRange.Cells(1).Group _
Start:=True, _
End:=True, _
Periods:=Array(False, False, False, False, True, False, True)
End With
With .PivotFields(2) 'Date renvoi
.Orientation = xlRowField
.Position = 1
.DataRange.Cells(1).Group _
Start:=True, _
End:=True, _
Periods:=Array(False, False, False, False, True, False, True)
End With
End With

'*************************** Mandat pivot table *****************************
Set rng = ThisWorkbook.Sheets(3).Cells
rng.Clear
With PC
Set PT = .CreatePivotTable(TableDestination:=rng(6, 1))
End With
With PT
With .PivotFields(1) 'Exercice
.Orientation = xlPageField
.Position = 1
End With
.AddDataField .PivotFields(26), "Intervention BSF", xlCount
With .PivotFields(27) 'Date mandat
.Orientation = xlColumnField
.Position = 1
.DataRange.Cells(1).Group _
Start:=True, _
End:=True, _
Periods:=Array(False, False, False, False, True, False, True)
End With
With .PivotFields(2) 'Date renvoi
.Orientation = xlRowField
.Position = 1
.DataRange.Cells(1).Group _
Start:=True, _
End:=True, _
Periods:=Array(False, False, False, False, True, False, True)
End With
End With

' Layout
ThisWorkbook.Sheets(1).Columns("A:B").ColumnWidth = 8
ThisWorkbook.Sheets(1).Columns("D:N").ColumnWidth = 4.5

'Clean up
Set PT = Nothing
Set PC = Nothing

ChDirNet strPath
Application.ScreenUpdating = True
End Sub

Private Sub DeleteConnections_12()
' This line won't work and wouldn't be necessary
' in the versions older than 2007
'*****************************************************************************
On Error Resume Next: ThisWorkbook.Connections(1).Delete: On Error GoTo 0
'*****************************************************************************
End Sub

Finalement de rien !!!
Au plaisir de te relire sur le Forum

Patrice