Compilation fichiers sous Excel 2003 ne fonctionne plus sous Excel 2013

Bonsoir =E0 tous,

J'utilisais jusqu'ici un petit script excel 2003 qui me servait =E0 compile=
r diff=E9rents fichiers excel sous une seule et m=EAme feuille.

Or nous venons de migrer en 2013.
Du coup j'ai une erreur que je n'arrive pas =E0 r=E9soudre.

Je pense ne pas =EAtre le seul =E0 l'utiliser.
Voici le script

Erreur compilation=20
Verifiez et mettez =E0 jour les instructions Declare, puis marquez-les avec=
l'attribut PtrSafe...

J'esp=E8re que vous pourrez m'aider car je ne vois pas...
mes comp=E9tences sont bien trop limit=E9es.

Merci d'avance !

Mclain

Option Explicit
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Private Const BIF_RETURNONLYFSDIRS =3D 1
Private Const MAX_PATH =3D 260

Declare Function FindWindow32 Lib "user32" Alias "FindWindowA" (ByVal lpCla=
ssName As String, ByVal lpWindowName As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpS=
tring1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInf=
o) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList A=
s Long, ByVal lpBuffer As String) As Long
Public Sub Recupere()
Dim fs As Variant ' syst=E8me fichiers
Dim chemin As String ' classeur regroup=E9
Dim rep As String ' r=E9pertoire =E0 traiter
Dim book As String ' classeur synth=E8se
Dim fic_lu As String ' classeur regroup=E9
Dim ligne As Long ' ligne =E9criture
Dim nbc As Integer ' nombre de classeurs
Dim nbf As Integer ' nombre de feuilles
Dim nbl As Integer ' nombre de lignes
Dim c As Integer ' nombre de colonnes
Dim i As Integer ' indice fichier
Dim j As Integer ' indice exclus
Dim k As Integer ' indice feuille
Dim l As Long ' ligne lecture
Dim Wb As Workbook ' classeur regroupement
Dim Wf As Worksheet ' feuille regroupement
Dim ndp As Long ' num=E9ro de proc=E9dure
Dim mxc As Long ' maximum colones feuille
Dim mxl As Long ' maximum lignes feuille
Dim exclus() As Variant ' onglets exclus
exclus =3D Array("P de Garde", "D=E9finition des colonnes") 'feuilles exclu=
es regroupement
ndp =3D FindWindow32("XLMAIN", Application.Caption)
rep =3D rech_rep(ndp, "Choisissez le r=E9pertoire =E0 regrouper")
If rep =3D "" Then Exit Sub
mxc =3D Cells(1, ActiveSheet.UsedRange.Columns.Count).End(xlToRight).Column
mxl =3D Cells(ActiveSheet.UsedRange.Rows.Count, 1).End(xlDown).Row
Application.ScreenUpdating =3D False
Application.EnableEvents =3D False
'On Error GoTo fin
book =3D ThisWorkbook.FullName ' Nom du classeur actuel
Set Wb =3D ThisWorkbook ' variable classeur groupe
Set Wf =3D Wb.ActiveSheet ' variable feuille groupe
nbc =3D 0: nbf =3D 0 ' initialisation variables
Set fs =3D Application.FileSearch ' recherche fichiers
ligne =3D 1
With fs
.LookIn =3D rep ' r=E9pertoire choisi
.Filename =3D "*.xls" ' classeurs Excel
.SearchSubFolders =3D True ' recherche sous r=E9pertoires
If .Execute(SortBy:=3DmsoSortByLastModified, SortOrder:=3DmsoSortOrderD=
escending) > 0 Then
For i =3D 1 To .FoundFiles.Count ' recherche fichiers
chemin =3D .FoundFiles(i) ' chemin fichiers
If chemin <> book Then ' diff=E9rent du classeur regroupan=
t
Workbooks.Open chemin, 0 ' ouverture
For k =3D 1 To Sheets.Count ' traitement onglets
For j =3D 0 To UBound(exclus)
If Not Sheets(k).Type < 0 Then Exit For
If Sheets(k).Name =3D exclus(j) Then Exit For
Next j
If j > UBound(exclus) Then
Sheets(k).Activate
nbl =3D ActiveSheet.UsedRange.Rows.Count
If ligne + nbl > mxl Then
ligne =3D 1 ' feuille pleine
Wb.Sheets.Add ' ajout d'une feuille
Set Wf =3D Wb.ActiveSheet
End If ' nom et contenu classeur
c =3D ActiveSheet.UsedRange.Columns.Count
If c =3D mxc Then c =3D mxc - 1
Wf.Hyperlinks.Add Anchor:=3DWf.Cells(ligne, 1), Address=
:=3Dchemin, _
TextToDisplay:=3DActiveWorkbook.Name & " [" & Sheet=
s(k).Name & "]"
' If ligne > 2 Then l =3D 3 Else l =3D 1 ' une seule fo=
is le titre
l =3D 1
Cells(l, 1).Resize(nbl, c).Copy Destination:=3DWf.Cells=
(ligne, 2)
Wf.Cells(ligne, 1).Resize(nbl, 1).FillDown
ligne =3D ligne + nbl
nbf =3D nbf + 1
End If
Next k
ActiveWorkbook.Close SaveChanges:=3DFalse ' Fermeture du =
classeur
nbc =3D nbc + 1
End If
Next i
For l =3D ligne To 2 Step -1
If Wf.Cells(ligne, mxc).End(xlToLeft).Column =3D 1 _
And Wf.Cells(ligne, 1).Value =3D "" Then
Wf.Rows(ligne).Delete
ligne =3D ligne - 1
End If
Next l
End If
End With
fin:
MsgBox nbc & " classeurs regroup=E9s avec " & nbf & " feuilles et " & l=
igne & " lignes"
Application.ScreenUpdating =3D True
Application.EnableEvents =3D True
End Sub


Private Function rech_rep(hWndOwner As Long, msg As String) As String

Dim lng As Integer ' longueur string r=E9pertoire choisi
Dim choix As Long ' choix r=E9pertoire effectu=E9
Dim res As Long ' r=E9ponse fonction
Dim rep As String ' r=E9pertoire choisi
Dim pbi As BrowseInfo ' param=E8tre browser infos

pbi.hWndOwner =3D hWndOwner
pbi.lpszTitle =3D lstrcat(msg, "")
pbi.ulFlags =3D BIF_RETURNONLYFSDIRS

choix =3D SHBrowseForFolder(pbi) ' affichage menu s=E9lection

If choix Then ' r=E9cup=E9ration r=E9pertoire
rep =3D String$(MAX_PATH, 0)
res =3D SHGetPathFromIDList(choix, rep)
Call CoTaskMemFree(choix)
lng =3D InStr(rep, vbNullChar)
If lng Then rep =3D Left$(rep, lng - 1)
End If
rech_rep =3D rep
End Function