Microsoft 365 Modification du plusieurs fichiers excel en une seule fois

[Zifox]

Bonjour à tous,

Je voudrais savoir si une personne serait capable de m'aider pour changer le code ci-dessous, ce code permet d'ouvrir un dossier et de modifier plusieurs fichier .txt entre autre en une seule fois . Le but est de l'adapter pour un format excel (car une fois la modification faite je ne peux plus ouvrir le fichier car endommagé) et je n'y arrive pas car mes compétences en VBA sont quasi nulles.
Merci d'avance pour votre aide.
Cordialement

                                                                     Option Explicit

Sub nettoyer()

    Dim ligne As Integer: Dim colonne As Integer
  
    ligne = 8
  
    While (Cells(ligne, 7).Value <> "")
        For colonne = 10 To 12
             Cells(ligne, colonne).Value = ""
        Next colonne
      
        ligne = ligne + 1
      
    Wend

End Sub


Sub traiter_dossier()

    Dim nom_dossier As String: Dim fichier As Object
    Dim le_dossier, chaque_fichier: Dim flux_lecture
    Dim ligne As Integer: Dim le_fichier As String
    Dim contenu As String: Dim chercher As String: Dim remplacer As String
    nom_dossier = Range("B7").Value
    chercher = Range("B10").Value
    remplacer = Range("B13").Value
    ligne = 8

    Set fichier = CreateObject("scripting.filesystemobject")
    Set le_dossier = fichier.getfolder(nom_dossier)
    Set flux_lecture = CreateObject("ADODB.Stream")
    flux_lecture.Charset = "utf-8"

    For Each chaque_fichier In le_dossier.Files
        le_fichier = nom_dossier & "\" & chaque_fichier.Name
        contenu = ""
      
      
        flux_lecture.Open
        flux_lecture.LoadFromFile (le_fichier)
        contenu = flux_lecture.ReadText()
        flux_lecture.Close
      
        contenu = Replace(contenu, chercher, remplacer)
      
        flux_lecture.Open
        flux_lecture.WriteText contenu
        flux_lecture.SaveToFile le_fichier, 2
        flux_lecture.Close
      
      
        Cells(ligne, 10).Value = chaque_fichier.Name
        Cells(ligne, 12).Value = "Ok"
        ligne = ligne + 1
      
    Next chaque_fichier
  
    Set flux_lecture = Nothing
    Set le_dossier = Nothing
    Set fichier = Nothing

End Sub


Sub Dossier()
    Dim bDialogue As Office.FileDialog
    Dim chDossier As String
  
    Set bDialogue = Application.FileDialog(msoFileDialogFolderPicker)
    bDialogue.Title = "Sélectionner un dossier à parcourir"

    If bDialogue.Show = -1 Then
        chDossier = bDialogue.SelectedItems(1)
        Range("B7").Value = chDossier
    End If
  
End Sub
Sub Demarrer()


    If (Range("B7").Value = "") Then
        MsgBox ("Vous devez désigner un dossier à parcourir avec le premier bouton")
        Exit Sub
    End If

    If (Range("B10").Value = "") Then
        MsgBox ("Vous devez spécifier un terme à remplacer")
        Exit Sub
    End If

    If (Range("B13").Value = "") Then
        MsgBox ("Vous devez spécifier un terme de remplacement")
        Exit Sub
    End If
  
    traiter_dossier
    nettoyer
End Sub

 

[TooFatBoy]

Bonjour,

ce code permet d'ouvrir un dossier et de modifier plusieurs fichier .txt entre autre en une seule fois .

Le but est de l'adapter pour un format excel (car une fois la modification faite je ne peux plus ouvrir le fichier car endommagé)

Que veux-tu dire par "adapter pour un format Excel" ? Tu veux modifier des fichiers .XLS? ??


Remarque : l'idéal est de fournir un classeur anonymisé.

 

[Zifox]

Bonjour,


Que veux-tu dire par "adapter pour un format Excel" ? Tu veux modifier des fichiers .XLS? ??


Remarque : l'idéal est de fournir un classeur anonymisé.

Bonjour,
Oui exactement modifier des fichiers XLS.
Et d’accord

 

[Zifox]

Bonjour à tous,

Je voudrais savoir si une personne serait capable de m'aider pour changer le code ci-dessous, ce code permet d'ouvrir un dossier et de modifier plusieurs fichier .txt entre autre en une seule fois . Le but est de l'adapter pour un format excel (car une fois la modification faite je ne peux plus ouvrir le fichier car endommagé) et je n'y arrive pas car mes compétences en VBA sont quasi nulles.
Merci d'avance pour votre aide.
Cordialement

J'ai trouvé un code pour ceux que cela intéresse:

                                                                                                                                                                      Sub Remplacer()

Dim tPath As String, tFile As String, ReplaceWhat As String, ReplaceWith As String

Dim wb As Workbook

Dim ws As Worksheet



'Change as required

ReplaceWhat = Range("B10").Value

ReplaceWith = Range("B13").Value



'The path where your files are saved

tPath = Range("C7").Value



Dim anti As String



'the *.* is all file types, *.xls will give you all xls files, *Reports.xls will give you all files ending with Reports.xls etc

tFile = Dir(tPath & "*.xls")

Application.ScreenUpdating = False



Do While Len(tFile) > 0

Set wb = Workbooks.Open(tPath & tFile)



'Assumes you have all data in the first sheet. Can be amended to loop through all sheets in workbook

Set ws = wb.Sheets(1)



ws.UsedRange.Replace ReplaceWhat, ReplaceWith

wb.Close True



tFile = Dir



Loop



End Sub