Code ne fonctionne plus

[Manon]

Bonjour à tous

J'ai réussi à monter un petit programme grâce à l'aide de plusieurs d'entre vous.

Il a bien fonctionné pendant longtemps.
Je l'ai sauvegardé sur une disquette et installé sur un autre poste XP.

Curieusement, sur mon poste(XP aussi), il me donne maintenant une erreur: Incompatibilité de type erreur13.
Fonctionne cependant très bien sur le 2e poste.

Qu'est-ce qui se passe ????
------------------------------
Mon code:
'bouton mise à jour client
Sub lancer()
Dim noms_de_fichiers As Variant, i As Integer, y As Integer

Application.ScreenUpdating = False

ChDrive 'D' 'Modifie la lettre du lecteur
ChDir 'D:\\Clients' 'Modifie le répertoire
noms_de_fichiers = créer_liste_fichiers('*.xls')

Workbooks('Gestion.xls').Activate 'Modifie le nom du classeur
Sheets('Clients').Select 'Modifie le nom de la feuille
Range('A1', Range('A1').End(xlDown)).Select
Selection.ClearContents
Range('A1').Select

'code afin que le chemin du dossier
'et les extensions du fichier ne soient pas visible
For i = 1 To UBound(noms_de_fichiers)...............ERREUR CODE 13
Cells(i, 1).Formula = Mid(noms_de_fichiers(i), 16, Len(noms_de_fichiers(i)) - 19) '
Next i

Dim currentcell, nextcell
Set currentcell = Worksheets('Gestion').Range('A1') 'Modifie le nom de la feuille
Do While Not IsEmpty(currentcell)
Dim nom_fichier
Set nextcell = currentcell.Offset(1, 0)
nom_fichier = currentcell.Value

For y = 1 To ActiveWorkbook.Sheets.Count

'Dans la ligne ci-dessous modifie éventuellement les noms de classeur et de feuille
Next y
Set currentcell = nextcell
Loop
Application.ScreenUpdating = True
Worksheets('Gestion').Select
End Sub

Public Function créer_liste_fichiers(Filtre As String)

'===========================================================================
'Fonction permettant de générer une liste des fichiers présents dans le
'répertoire courant
'Cette liste va être générée dans la procédure Lancer
'===========================================================================

Dim listefichiers() As String, comptefichier As Long
créer_liste_fichiers = ''
Erase listefichiers

If Filtre = '' Then Filtre = '*.xls,es1'
With Application.FileSearch
.NewSearch
.LookIn = CurDir
.Filename = Filtre
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute(SortBy:=msoSortByFileName, _
sortorder:=msoSortOrderAscending) = 0 Then Exit Function
ReDim listefichiers(.FoundFiles.Count)
For comptefichier = 1 To .FoundFiles.Count
listefichiers(comptefichier) = .FoundFiles(comptefichier)

Next comptefichier
.FileType = msoFileTypeExcelWorkbooks
End With
créer_liste_fichiers = listefichiers
Erase listefichiers
End Function


Merci à tous

Manon

 

[Charly2]

Bonsoir Manon, bonsoir (eh oui... encore !!!) à toutes et à tous

Avec une erreur de ce genre :

ERREUR CODE 13 = incompatibilité de type, sur la ligne :

For i = 1 To UBound(noms_de_fichiers)

c'est, à priori, que ta variable noms_de_fichiers n'est pas un tableau.

Tu devrais aller vérifier du côté de Public Function créer_liste_fichiers(Filtre As String) qui ne doit pas retourner un tableau : as-tu bien des fichiers .xls et/ou es1 dans ton répertoire D:\\Clients (existe-t-il sur ta machine ?)

Fais un test après l'appel de ta fonction pour vérifier que noms_de_fichiers ne contient pas la valeur Empty.

Bon courage

A+

 

[Manon]

Bonsoir à tous , Charly

Je te remercie pour ta réponse, mais je ne te suis pas du tout. (débutante)

J'ai réinstaller mon programme sur un 3e poste et il fonctionne très bien.

Est-il possible qu'une autre application interfère avec mon code ????????

Merci

Manon

 

[Charly2]

Bonjour Manon, bonjour à toutes et à tous

Je vais être plus simple dans mes explication (enfin, j'espère :unsure: ) :

Ta procédure principale sélectionne le lecteur D: , puis dans ce lecteur, elle sélectionne le répertoire D:\\\\\\\\Clients.

Elle appelle ensuite une sous-procédure qui recherche les fichiers Excel (extension .xls) et les fichiers avec une extension .es1 , ma remarque est la suivante :

-> vérifie que le lecteur et le répertoire existent bien sur les postes sur lesquels ton appli ne fonctionne pas. Et s'ils existent, vérifie qu'il y a bien des fichiers avec les extension cherchée.

Je ne sais pas si j'ai été assez clair :huh: .

Tiens nous au courant...

A+

 

[Manon]

Bonjour Charly, bounjour le forum,

J'ai vérifié et j'ai bien le dossier et des classeurs .xls.

J'ai oté l'extension es1 du code sur mon poste
(même s'il reste sur les autres postes).

pour avoir:
If Filtre = '' Then Filtre = '*.xls'

Mais j'ai toujours la même erreur.
Mystère!

Merci de ta patience

Manon

 

[MichelXld]

bonsoir Manon , bonsoir cher ami Charly

le probleme est peut etre lié à la méthode FileSearch qui ne fonctionne pas bien sur certaines versions d'XP , comme indiqué dans ce lien

Lien supprimé


bonne soirée
MichelXld

 

[Manon]

Bonsoir MichelXld, Charly, le forum


Je crois que tu as trouvé le problème. Il ne reste qu'à trouver la solution.

J'ai fait le test macro en le modifiant parce que j'ai WinXP

Option Explicit

Sub ListFichiers()
Dim ThisBookPath As String
Dim SearchFile As FileSearch
Dim ThePath As String
Dim i As Integer

Set SearchFile = Application.FileSearch
ThePath = 'C:\\Mes documents\\' '<< 0 Then
With .FoundFiles
For i = 1 To .Count
Cells(i, 1) = Dir(.Item(i))
Next i
End With
Else
MsgBox 'No File Found ' & ThePath
End If

Curieusement, il trouve tout sur le C mais rien sur mon D.

Quelqu'un a peut-être la solution ?
Comment puis-je régler ça. J'ai dû faire quelque chose à mon ordi parce que ce code fonctionnait très bien avant.

Merci

Manon

 

[Manon]

Bonjour à tous,


J'ai trouvé la solution.

Il m'a suffit d'enlever l'INDEXATION des fichiers dans la recherche de Excell.

Je le mentionne au cas où une autre personne aurait le même problème

Merci à tous.

Manon