Message erreur Excel [Résolu]

Pouvez-vous m'aider ?

Sans aucune explication du contexte, ça va être très difficile !!!

Avec le code, peut-être ?

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
___________________________________________________________

«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»

Mais encore ??? (pas de rouge ni de sur-lignage dans ce message)

Bonjour Patrice33740,

Je ne suis pas capable de le mettre en rouge ! Cependant, j'ai fais plusieurs test et il semblerait que j'ai de la difficulté avec une feuille Excel d'une employée. Lorsque je lance la macro avec les autres feuilles excel des employés elle roule bien. Cependant lorsque je lance la macro avec la feuille excel en question elle roule bien. cependant lorsque je la lance avec seulement un autre employé elle ne roule plus.
donc, je présume que le problème se situe dans la feuilles Excel de l'employée.

Donc, je ne peux pas surligner la ligne en question donc la voici en texte elle se trouve sous global pivote table:

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

Merci pour ton aide!

Rebonjour Patrice33740,

J'ai finalement trouver un aute moyen pour éliminer l'erreur. J'ai tout simplement créer une autre feuille Excel pour l'employée en question et supprimer l'ancienne et cela à marcher!
La macro roule à merveille !!!

J'aimerais te remercie pour ton temps et ton aide !

Bonne fin journée !

1407Sunshine.