Je ne sais pas si l'ensemble te sera utile mais à priori cela crée une liste des fichiers RTF trouvés dans le Dossier Lambda puis les ouvre , cherche/remplace, sauve puis ferme ces RTF
Cela reste à tester plus à fond et sans doute à optimiser
Option Explicit
Dim Tableau() As String
Dim DossierOK As String
' Dossier contenant les fichiers RTF
Const Dossier = "C:\Word\RTF"
Const CharATrouver = "."
Const CharRemplacement = ":"
Public Sub Test()
Dim i As Long
Dim FichiersRTF As String
Dim NomFichier As String
Dim NbFichiers As Long
DossierOK = Dossier
If Right(DossierOK, 1) <> "\" Then DossierOK = DossierOK + "\"
FichiersRTF = DossierOK + "*.rtf"
NomFichier = Dir(FichiersRTF)
Erase Tableau
NbFichiers = 0
Do While Len(NomFichier) > 0
NbFichiers = NbFichiers + 1
ReDim Preserve Tableau(1 To NbFichiers)
Tableau(NbFichiers) = NomFichier
NomFichier = Dir()
Loop
If NbFichiers > 0 Then
Application.ScreenUpdating = False
BalayageFichiersRTF
Application.ScreenUpdating = True
End If
End Sub
Private Sub BalayageFichiersRTF()
Dim i As Long
ChangeFileOpenDirectory DossierOK
For i = 1 To UBound(Tableau)
Documents.Open FileName:=Tableau(i), Format:=wdOpenFormatAuto
RemplacerDansFichier
Next
End Sub
Private Sub RemplacerDansFichier()
ActiveDocument.Select
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = CharATrouver
.Replacement.Text = CharRemplacement
.Forward = True
.Execute
End With
If Selection.Find.Found = False Then
ActiveDocument.Close
Exit Sub
End If
Selection.Find.Execute Replace:=wdReplaceAll
With ActiveDocument
.Save
.Close
End With
End Sub
|
s'il s'agit d'utiliser une fonction/procédure externe il faudra adapter qqch du genre
Application.Run "[TemplateName].[ModuleName].[MacroName]
Par exemple Application.Run "Normal.NewMacros.Macro1"
|
Message édité par kiki29 le 25-10-2006 à 10:45:21
