Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Supprimer le message si feuille inexistante (en VB)

Supprimer le message si feuille inexistante (en VB)

7 réponses
Avatar
Myriam
Bonjour à toutes et tous !!

J'ai réalisé cette macro (avec l'aide de beaucoup d'entre vous !! MERCI !!!)

Sub Modification()
Dim F
With Application.FileSearch
.NewSearch
.LookIn = "D:\Contrôles\Modèles\Par Type - Mise en Service\"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
On Error GoTo Erreur
Sheets("Caractéristique").Select
Cells.Replace What:="Référence : 0214521145", Replacement:="Référence :
DEP21054OTIS", LookAt:= xlPart, SearchOrder:=xlByRows, MatchCase:=False
ActiveWorkbook.Save

Erreur:
ActiveWorkbook.Close

Next F
MsgBox "Pas ou Plus de fichiers", vbInformation, "Terminé"
End With
End Sub


Mais je rencontre un problème !!
Si la feuille 'Caractéristique' n'existe pas, j'ai un message d'erreur que
le On Error ne gère pas !!
Merci de votre aide !!


PS : Si quelqu'un à une astuce pour avoir la boite d'ouveture pour choisir
le dossier à la place de : .LookIn = "D:\Contrôles\Modèles\Par Type -
Mise en Service\"
______________________________________
J'aime bien les NewsGroup mais pas les virus !!!
Retirer Virgule. si vous voulez répondre !!
Myriam.M Virgule.la.bande.a.Basil@Netcourrier.com
Signaler un problème avec ce contenu

7 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Papou
Myriam
Voici une proposition que je n'ai pas pu tester pour l'instant, elle intègre
une fonction (de John Walkenbach) permettant de rechercher un dossier dans
l'arborescence et quelques peites modifs perso pour gérer les cas d'erreurs
dans ton code...
...mais c'est vraiment du vite fait car je dois partir, je ne pourrais pas
revenir avant demain sur le forum mais il y aura bien quelqu'un qui pourra
prendre la suite ;-)

Bon courage
Cordialement
Pascal

Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As
String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

'Définit le Bureau comme dossier racine
bInfo.pidlRoot = 0&

'Invite de la boite de dialogue
If IsMissing(Msg) Then
bInfo.lpszTitle = "Selectionnez un dossier."
Else
bInfo.lpszTitle = Msg
End If

'Type de renvoi : dossier
' bInfo.ulFlags = &H1
'Type de renvoi : fichier
bInfo.ulFlags = &H4000


'Affiche la boite de dialogue
x = SHBrowseForFolder(bInfo)

'Traite le résultat
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function
Sub Modification()
Dim F, LeRep
With Application.FileSearch
.NewSearch
LeRep = GetDirectory
On Error GoTo Err_PasdeRep
.LookIn = LeRep
.Execute
On Error Resume Next 'pourquoi ?
For Each F In .FoundFiles
Workbooks.Open F
On Error GoTo Err_PasdeFeuille
Sheets("Caractéristique").Cells.Replace What:="Référence : 0214521145",
Replacement:="Référence :"
DEP21054OTIS ", LookAt:= xlPart, SearchOrder:=xlByRows, MatchCase:úlse"
ActiveWorkbook.Save
Next F
End With
MsgBox "Pas ou Plus de fichiers", vbInformation, "Terminé"
Exit Sub


Err_PasdeRep:
MsgBox "Aucun dossier n'a été sélectionné", vbInformation, "Arrêt"
Exit Sub

Err_PasdeFeuille:
MsgBox "La feuille Caractéristique n'a pas été trouvée", vbInformation,
"Arrêt"
Exit Sub

End Sub

"Myriam" a écrit dans le message
de news:OpaXZ$
Bonjour à toutes et tous !!

J'ai réalisé cette macro (avec l'aide de beaucoup d'entre vous !! MERCI
!!!)


Sub Modification()
Dim F
With Application.FileSearch
.NewSearch
.LookIn = "D:ContrôlesModèlesPar Type - Mise en Service"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
On Error GoTo Erreur
Sheets("Caractéristique").Select
Cells.Replace What:="Référence : 0214521145", Replacement:="Référence
:

DEP21054OTIS", LookAt:= xlPart, SearchOrder:=xlByRows, MatchCase:úlse
ActiveWorkbook.Save

Erreur:
ActiveWorkbook.Close

Next F
MsgBox "Pas ou Plus de fichiers", vbInformation, "Terminé"
End With
End Sub


Mais je rencontre un problème !!
Si la feuille 'Caractéristique' n'existe pas, j'ai un message d'erreur que
le On Error ne gère pas !!
Merci de votre aide !!


PS : Si quelqu'un à une astuce pour avoir la boite d'ouveture pour choisir
le dossier à la place de : .LookIn = "D:ContrôlesModèlesPar Type -
Mise en Service"
______________________________________
J'aime bien les NewsGroup mais pas les virus !!!
Retirer Virgule. si vous voulez répondre !!
Myriam.M




Avatar
Hervé
Salut Myriam,
J'ai un peu retouché ton code, mais regarde si cela te convient :

Sub Modification()
Dim Fs As FileSearch
Dim F
Dim Dossier As String

With Application.FileDialog(4)
.AllowMultiSelect = False
.Show
Dossier = .SelectedItems(1)
End With

Set Fs = Application.FileSearch

With Fs
.NewSearch
.LookIn = Dossier
.Filename = "*.xls"
If .Execute > 0 Then
For Each F In .FoundFiles
Workbooks.Open F
On Error Resume Next
If IsError(Sheets("Caractéristique")) Then
ActiveWorkbook.Close
Else
Sheets("Caractéristique") _
.Cells.Replace What:="Référence : 0214521145", _
Replacement:="Référence : DEP21054OTIS ", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:úlse
ActiveWorkbook.Save
End If
Next F
MsgBox "Tous les fichiers ont été traités !", vbInformation,
"Terminé."
Else
MsgBox "Aucun fichiers dans le dossier !", vbInformation, "Aucun
fichiers."
End If
End With

Set Fs = Nothing

End Sub

Hervé.

"Myriam" a écrit dans le message
de news: OpaXZ$
Bonjour à toutes et tous !!

J'ai réalisé cette macro (avec l'aide de beaucoup d'entre vous !! MERCI
!!!)


Sub Modification()
Dim F
With Application.FileSearch
.NewSearch
.LookIn = "D:ContrôlesModèlesPar Type - Mise en Service"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
On Error GoTo Erreur
Sheets("Caractéristique").Select
Cells.Replace What:="Référence : 0214521145", Replacement:="Référence
:

DEP21054OTIS", LookAt:= xlPart, SearchOrder:=xlByRows, MatchCase:úlse
ActiveWorkbook.Save

Erreur:
ActiveWorkbook.Close

Next F
MsgBox "Pas ou Plus de fichiers", vbInformation, "Terminé"
End With
End Sub


Mais je rencontre un problème !!
Si la feuille 'Caractéristique' n'existe pas, j'ai un message d'erreur que
le On Error ne gère pas !!
Merci de votre aide !!


PS : Si quelqu'un à une astuce pour avoir la boite d'ouveture pour choisir
le dossier à la place de : .LookIn = "D:ContrôlesModèlesPar Type -
Mise en Service"
______________________________________
J'aime bien les NewsGroup mais pas les virus !!!
Retirer Virgule. si vous voulez répondre !!
Myriam.M




Avatar
Myriam
Merci !!

"Hervé" a écrit dans le message de
news:
Salut Myriam,
J'ai un peu retouché ton code, mais regarde si cela te convient :

Sub Modification()
Dim Fs As FileSearch
Dim F
Dim Dossier As String

With Application.FileDialog(4)
.AllowMultiSelect = False
.Show
Dossier = .SelectedItems(1)
End With

Set Fs = Application.FileSearch

With Fs
.NewSearch
.LookIn = Dossier
.Filename = "*.xls"
If .Execute > 0 Then
For Each F In .FoundFiles
Workbooks.Open F
On Error Resume Next
If IsError(Sheets("Caractéristique")) Then
ActiveWorkbook.Close
Else
Sheets("Caractéristique") _
.Cells.Replace What:="Référence : 0214521145", _
Replacement:="Référence : DEP21054OTIS ", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:úlse
ActiveWorkbook.Save
End If
Next F
MsgBox "Tous les fichiers ont été traités !", vbInformation,
"Terminé."
Else
MsgBox "Aucun fichiers dans le dossier !", vbInformation, "Aucun
fichiers."
End If
End With

Set Fs = Nothing

End Sub

Hervé.

"Myriam" a écrit dans le message
de news: OpaXZ$
Bonjour à toutes et tous !!

J'ai réalisé cette macro (avec l'aide de beaucoup d'entre vous !! MERCI
!!!)


Sub Modification()
Dim F
With Application.FileSearch
.NewSearch
.LookIn = "D:ContrôlesModèlesPar Type - Mise en Service"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
On Error GoTo Erreur
Sheets("Caractéristique").Select
Cells.Replace What:="Référence : 0214521145",
Replacement:="Référence


:
DEP21054OTIS", LookAt:= xlPart, SearchOrder:=xlByRows, MatchCase:úlse
ActiveWorkbook.Save

Erreur:
ActiveWorkbook.Close

Next F
MsgBox "Pas ou Plus de fichiers", vbInformation, "Terminé"
End With
End Sub


Mais je rencontre un problème !!
Si la feuille 'Caractéristique' n'existe pas, j'ai un message d'erreur
que


le On Error ne gère pas !!
Merci de votre aide !!


PS : Si quelqu'un à une astuce pour avoir la boite d'ouveture pour
choisir


le dossier à la place de : .LookIn = "D:ContrôlesModèlesPar Type -
Mise en Service"
______________________________________
J'aime bien les NewsGroup mais pas les virus !!!
Retirer Virgule. si vous voulez répondre !!
Myriam.M








Avatar
Myriam
Bonjour !

Ton exemple bloque sur : With Application.FileDialog(4)

Je ne trouve pas d'info dans l'aide !!
--
______________________________________
J'aime bien les NewsGroup mais pas les virus !!!
Retirer Virgule. si vous voulez répondre !!
Myriam.M
"Hervé" a écrit dans le message de news:

Salut Myriam,
J'ai un peu retouché ton code, mais regarde si cela te convient :

Sub Modification()
Dim Fs As FileSearch
Dim F
Dim Dossier As String

With Application.FileDialog(4)
.AllowMultiSelect = False
.Show
Dossier = .SelectedItems(1)
End With

Set Fs = Application.FileSearch

With Fs
.NewSearch
.LookIn = Dossier
.Filename = "*.xls"
If .Execute > 0 Then
For Each F In .FoundFiles
Workbooks.Open F
On Error Resume Next
If IsError(Sheets("Caractéristique")) Then
ActiveWorkbook.Close
Else
Sheets("Caractéristique") _
.Cells.Replace What:="Référence : 0214521145", _
Replacement:="Référence : DEP21054OTIS ", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:úlse
ActiveWorkbook.Save
End If
Next F
MsgBox "Tous les fichiers ont été traités !", vbInformation,
"Terminé."
Else
MsgBox "Aucun fichiers dans le dossier !", vbInformation, "Aucun
fichiers."
End If
End With

Set Fs = Nothing

End Sub

Hervé.

"Myriam" a écrit dans le message
de news: OpaXZ$
Bonjour à toutes et tous !!

J'ai réalisé cette macro (avec l'aide de beaucoup d'entre vous !! MERCI
!!!)


Sub Modification()
Dim F
With Application.FileSearch
.NewSearch
.LookIn = "D:ContrôlesModèlesPar Type - Mise en Service"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
On Error GoTo Erreur
Sheets("Caractéristique").Select
Cells.Replace What:="Référence : 0214521145",
Replacement:="Référence


:
DEP21054OTIS", LookAt:= xlPart, SearchOrder:=xlByRows, MatchCase:úlse
ActiveWorkbook.Save

Erreur:
ActiveWorkbook.Close

Next F
MsgBox "Pas ou Plus de fichiers", vbInformation, "Terminé"
End With
End Sub


Mais je rencontre un problème !!
Si la feuille 'Caractéristique' n'existe pas, j'ai un message d'erreur
que


le On Error ne gère pas !!
Merci de votre aide !!


PS : Si quelqu'un à une astuce pour avoir la boite d'ouveture pour
choisir


le dossier à la place de : .LookIn = "D:ContrôlesModèlesPar Type -
Mise en Service"
______________________________________
J'aime bien les NewsGroup mais pas les virus !!!
Retirer Virgule. si vous voulez répondre !!
Myriam.M








Avatar
papou
Bonjour
Remplace 4 par
msoFileDialogFolderPicker

Cordialement
Pascal

"Myriam" a écrit dans le message
de news:
Bonjour !

Ton exemple bloque sur : With Application.FileDialog(4)

Je ne trouve pas d'info dans l'aide !!
--
______________________________________
J'aime bien les NewsGroup mais pas les virus !!!
Retirer Virgule. si vous voulez répondre !!
Myriam.M
"Hervé" a écrit dans le message de news:

Salut Myriam,
J'ai un peu retouché ton code, mais regarde si cela te convient :

Sub Modification()
Dim Fs As FileSearch
Dim F
Dim Dossier As String

With Application.FileDialog(4)
.AllowMultiSelect = False
.Show
Dossier = .SelectedItems(1)
End With

Set Fs = Application.FileSearch

With Fs
.NewSearch
.LookIn = Dossier
.Filename = "*.xls"
If .Execute > 0 Then
For Each F In .FoundFiles
Workbooks.Open F
On Error Resume Next
If IsError(Sheets("Caractéristique")) Then
ActiveWorkbook.Close
Else
Sheets("Caractéristique") _
.Cells.Replace What:="Référence : 0214521145", _
Replacement:="Référence : DEP21054OTIS ", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:úlse
ActiveWorkbook.Save
End If
Next F
MsgBox "Tous les fichiers ont été traités !", vbInformation,
"Terminé."
Else
MsgBox "Aucun fichiers dans le dossier !", vbInformation, "Aucun
fichiers."
End If
End With

Set Fs = Nothing

End Sub

Hervé.

"Myriam" a écrit dans le
message


de news: OpaXZ$
Bonjour à toutes et tous !!

J'ai réalisé cette macro (avec l'aide de beaucoup d'entre vous !!
MERCI



!!!)

Sub Modification()
Dim F
With Application.FileSearch
.NewSearch
.LookIn = "D:ContrôlesModèlesPar Type - Mise en Service"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
On Error GoTo Erreur
Sheets("Caractéristique").Select
Cells.Replace What:="Référence : 0214521145",
Replacement:="Référence


:
DEP21054OTIS", LookAt:= xlPart, SearchOrder:=xlByRows,
MatchCase:úlse



ActiveWorkbook.Save

Erreur:
ActiveWorkbook.Close

Next F
MsgBox "Pas ou Plus de fichiers", vbInformation, "Terminé"
End With
End Sub


Mais je rencontre un problème !!
Si la feuille 'Caractéristique' n'existe pas, j'ai un message d'erreur
que


le On Error ne gère pas !!
Merci de votre aide !!


PS : Si quelqu'un à une astuce pour avoir la boite d'ouveture pour
choisir


le dossier à la place de : .LookIn = "D:ContrôlesModèlesPar
Type -



Mise en Service"
______________________________________
J'aime bien les NewsGroup mais pas les virus !!!
Retirer Virgule. si vous voulez répondre !!
Myriam.M












Avatar
papou
Re
Précision importante :
Fonctionne avec Excel 2003 mais cette méthode de sélection de dossier n'est
pas disponible dans la version Excel 2000 en tout cas.
Cordialement
Pascal

"papou" <cestpasbonprobin@çanonpluscg44.fr> a écrit dans le message de
news:%23R$
Bonjour
Remplace 4 par
msoFileDialogFolderPicker

Cordialement
Pascal

"Myriam" a écrit dans le message
de news:
Bonjour !

Ton exemple bloque sur : With Application.FileDialog(4)

Je ne trouve pas d'info dans l'aide !!
--
______________________________________
J'aime bien les NewsGroup mais pas les virus !!!
Retirer Virgule. si vous voulez répondre !!
Myriam.M
"Hervé" a écrit dans le message de news:

Salut Myriam,
J'ai un peu retouché ton code, mais regarde si cela te convient :

Sub Modification()
Dim Fs As FileSearch
Dim F
Dim Dossier As String

With Application.FileDialog(4)
.AllowMultiSelect = False
.Show
Dossier = .SelectedItems(1)
End With

Set Fs = Application.FileSearch

With Fs
.NewSearch
.LookIn = Dossier
.Filename = "*.xls"
If .Execute > 0 Then
For Each F In .FoundFiles
Workbooks.Open F
On Error Resume Next
If IsError(Sheets("Caractéristique")) Then
ActiveWorkbook.Close
Else
Sheets("Caractéristique") _
.Cells.Replace What:="Référence : 0214521145", _
Replacement:="Référence : DEP21054OTIS ", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:úlse
ActiveWorkbook.Save
End If
Next F
MsgBox "Tous les fichiers ont été traités !", vbInformation,
"Terminé."
Else
MsgBox "Aucun fichiers dans le dossier !", vbInformation,
"Aucun



fichiers."
End If
End With

Set Fs = Nothing

End Sub

Hervé.

"Myriam" a écrit dans le
message


de news: OpaXZ$
Bonjour à toutes et tous !!

J'ai réalisé cette macro (avec l'aide de beaucoup d'entre vous !!
MERCI



!!!)

Sub Modification()
Dim F
With Application.FileSearch
.NewSearch
.LookIn = "D:ContrôlesModèlesPar Type - Mise en Service"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
On Error GoTo Erreur
Sheets("Caractéristique").Select
Cells.Replace What:="Référence : 0214521145",
Replacement:="Référence


:
DEP21054OTIS", LookAt:= xlPart, SearchOrder:=xlByRows,
MatchCase:úlse



ActiveWorkbook.Save

Erreur:
ActiveWorkbook.Close

Next F
MsgBox "Pas ou Plus de fichiers", vbInformation, "Terminé"
End With
End Sub


Mais je rencontre un problème !!
Si la feuille 'Caractéristique' n'existe pas, j'ai un message
d'erreur




que
le On Error ne gère pas !!
Merci de votre aide !!


PS : Si quelqu'un à une astuce pour avoir la boite d'ouveture pour
choisir


le dossier à la place de : .LookIn = "D:ContrôlesModèlesPar
Type -



Mise en Service"
______________________________________
J'aime bien les NewsGroup mais pas les virus !!!
Retirer Virgule. si vous voulez répondre !!
Myriam.M
















Avatar
Hervé
Salut Myriam,
Désolé, effectivement, c'est à partir d'Excel XP qu'a été introduite cette
fonction.
Voici un code complet qui fonctionne (enfin je pense car c'est le cas chez
moi) :

Private Declare Function GetOpenFileName _
Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type


Function Ouvrir() As String
Dim OuvNomFich As OPENFILENAME
'Pour que le chemin du dossier puisse
'être récupéré, un fichier (au hasard)
'devra être sélectionné
With OuvNomFich
'taille de la structure.
.lStructSize = Len(OuvNomFich)
'filtre
.lpstrFilter = "Fichiers Excel (*.xls)" & Chr$(0) & "*.xls"
'tampon avec le nom du fichier
.lpstrFile = Space(254)
'Longueur maximale de retour du fichier
.nMaxFile = 255
'tampon avec pour le titre du fichier
.lpstrFileTitle = .lpstrFile
'Longueur max de retour
.nMaxFileTitle = .nMaxFile
'dossier par défaut
.lpstrInitialDir = "D:"
'titre de la boîte
.lpstrTitle = "Choisir un dossier !"
'aucun flag
.flags = 0

'affiche la boîte "Ouvrir"
If GetOpenFileName(OuvNomFich) <> 0 Then
'récupère juste le chemin du dossier
Ouvrir = Left(Trim$(.lpstrFile), _
Len(Trim$(.lpstrFile)) - Len(Trim$(.lpstrFileTitle)))
Else
Ouvrir = "Annulé"
End If
End With

End Function

Sub Modification()
Dim Fs As FileSearch
Dim F
Dim Dossier As String

'demande le chemin du dossier
Dossier = Ouvrir
'si annulation
If Dossier = "Annulé" Then
MsgBox "Vous avez annulé l'ouverture du dossier !" _
& vbCrLf _
& "Aucune mise à jour ne sera faite !"
Exit Sub
End If

Set Fs = Application.FileSearch

With Fs
.NewSearch
.LookIn = Dossier
.Filename = "*.xls"
If .Execute > 0 Then
For Each F In .FoundFiles
Workbooks.Open F
On Error Resume Next
If IsError(Sheets("Caractéristique")) Then
ActiveWorkbook.Close
Else
Sheets("Caractéristique") _
.Cells.Replace What:="Référence : 0214521145", _
Replacement:="Référence : DEP21054OTIS ", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:úlse
ActiveWorkbook.Save
End If
Next F
MsgBox "Tous les fichiers ont été traités !", _
vbInformation, "Terminé."
Else
MsgBox "Aucun fichiers dans le dossier !", _
vbInformation, "Aucun fichiers."
End If
End With

Set Fs = Nothing

End Sub

Hervé.

"Myriam" a écrit dans le message
de news:
Bonjour !

Ton exemple bloque sur : With Application.FileDialog(4)

Je ne trouve pas d'info dans l'aide !!
--
______________________________________
J'aime bien les NewsGroup mais pas les virus !!!
Retirer Virgule. si vous voulez répondre !!
Myriam.M
"Hervé" a écrit dans le message de news:

Salut Myriam,
J'ai un peu retouché ton code, mais regarde si cela te convient :

Sub Modification()
Dim Fs As FileSearch
Dim F
Dim Dossier As String

With Application.FileDialog(4)
.AllowMultiSelect = False
.Show
Dossier = .SelectedItems(1)
End With

Set Fs = Application.FileSearch

With Fs
.NewSearch
.LookIn = Dossier
.Filename = "*.xls"
If .Execute > 0 Then
For Each F In .FoundFiles
Workbooks.Open F
On Error Resume Next
If IsError(Sheets("Caractéristique")) Then
ActiveWorkbook.Close
Else
Sheets("Caractéristique") _
.Cells.Replace What:="Référence : 0214521145", _
Replacement:="Référence : DEP21054OTIS ", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:úlse
ActiveWorkbook.Save
End If
Next F
MsgBox "Tous les fichiers ont été traités !", vbInformation,
"Terminé."
Else
MsgBox "Aucun fichiers dans le dossier !", vbInformation, "Aucun
fichiers."
End If
End With

Set Fs = Nothing

End Sub

Hervé.

"Myriam" a écrit dans le
message


de news: OpaXZ$
Bonjour à toutes et tous !!

J'ai réalisé cette macro (avec l'aide de beaucoup d'entre vous !!
MERCI



!!!)

Sub Modification()
Dim F
With Application.FileSearch
.NewSearch
.LookIn = "D:ContrôlesModèlesPar Type - Mise en Service"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
On Error GoTo Erreur
Sheets("Caractéristique").Select
Cells.Replace What:="Référence : 0214521145",
Replacement:="Référence


:
DEP21054OTIS", LookAt:= xlPart, SearchOrder:=xlByRows,
MatchCase:úlse



ActiveWorkbook.Save

Erreur:
ActiveWorkbook.Close

Next F
MsgBox "Pas ou Plus de fichiers", vbInformation, "Terminé"
End With
End Sub


Mais je rencontre un problème !!
Si la feuille 'Caractéristique' n'existe pas, j'ai un message d'erreur
que


le On Error ne gère pas !!
Merci de votre aide !!


PS : Si quelqu'un à une astuce pour avoir la boite d'ouveture pour
choisir


le dossier à la place de : .LookIn = "D:ContrôlesModèlesPar
Type -



Mise en Service"
______________________________________
J'aime bien les NewsGroup mais pas les virus !!!
Retirer Virgule. si vous voulez répondre !!
Myriam.M