Mettre à jour des fichiers Word en série

Bonjour à tous,

Me voilà de retour avec un nouveau problème!

J'ai une base de données d'un millier de lignes qui contient toutes les adresses et noms des fichiers que je dois mettre à jour (Colonne B et C dans la feuille 1)

Chaque fichier existe déjà sous un nom connu dans la colonne C comme "Ville_contrôle annuel_2020"

J'aimerais par VBA atteindre ces fichiers Word changer quelques infos (Colonne E à J) dans le fichier et l'enregistrer sous un nouveau nom (Colonne D) dans le même dossier (En série bien sûr).

Je n'ai rien trouvé dans ce sens ici.

Merci beaucoup d'avance pour votre aide

Andreas

Bonjour

Avec un exemple de document word à mettre à jour ce serait plus facile

Bonjour Yal_excel,

Merci déjà pour votre intérêt et votre dévouement a ma cause

Voici donc le fichier, je dois dire que le fichier original est bien plus complexe! (Mais trop confidentiel )

Merci d'avance

Cordialement

Andreas

Bonsoir

Une proposition qui marche avec les éléments dont je dispose.

Bonjour Yal,

Merci, je regarde ça dans la journée, je vous tiens au courant si c'est adaptable a mon souci.

Très bonne journée a vous.

Andreas

Re-bonjour,

Merci c'est exactement ça que je cherche (Si ça ne modifie pas les autres partie du document).

Comme je ne trouve pas la logique comment la macro s'adresse dans le document Word, je ne suis pas en mesure de l'adapter .

J'ai mis en fichier joint le fichier original (Vidé) sauf pour les champs a modifier (en orange).

Est-ce adaptable?

Encore milles Merci pour le temps consacré

Cdt

Andreas

Bonjour

Nous aurions gagné du temps si vous aviez envoyé ce document dès le début. Sous réserve que la structure de ce dernier document soit conforme voici une solution qui devrait fonctionner.

Cordialement

Re-bonjour,

Merci c'est parfait!

Je suis désolé pour cette perte de temps, je pensais a une autre démarche ou je ne voyais pas ces détails.

Milles mercis

Cordialement

Andreas

Pas de souci

Cordialement

Re,

serait-il possible de mettre en place un filtre sur une colonne : Que seul les lignes avec "XOui" dans la colonne 4 soit prise en compte ?

Et si le fichier avec le nom final éxiste déjà, il soit ignoré.

J'en demande beaucoup, mais je galère depuis ce matin pour trouver

Cordialement

Andreas

Je ne vois d"Xoui nul part et dans la colonne 4 il y a le nouveau nom sinon oui c'est possible il suffit de filtrer le tableau d'entrée

"Et si le fichier avec le nom final existe déjà, il soit ignoré." ? c'est à dire qu'il soit écrasé ou qu'il ne soit pas remplacé?

Re,

En faite ma base de données, fait 120 colonnes, a la 4ème se trouve le filtre désiré.

Et pour la question si le fichier existe déjà, il faut l'ignorer et passer au suivant.

J'ai pu utilisé ton code a merveille sur mon system, c'est top, merci

Andreas

Je peux regarder ça donc ifaudrait filtrer les enregistrements qui continnent "Xoui" en 4ème colonne et ne traiter que les fichiers qui n'existe pas encore.

Non testé puisque le fichiers ne correspondent pas mais en principe ça marche.

Bonjour,

Je me permet de revenir, car j'ai une erreur sur" End if sans if" et je ne trouve pas de solution!

Je suis navré, Merci d'avance

Option Explicit

Sub Eval_env_updat()
  Dim ch$
  Dim tb1()
  Dim i!, j!, k!, n%
  Dim wordApp As Object
  Dim oDoc As Word.Document
  Dim docWord$, nomFichier$

  tb1 = Range("Tableau1").Value2
  If tb1(i, 4) = "Xoui" Then
    Set wordApp = CreateObject("word.Application")
    With wordApp
      .Visible = True: .Activate
    End With

    For i = 1 To UBound(tb1)
      ch = tb1(i, 68) & "\"
      docWord = tb1(i, 70) & ".docx"
      If Dir(ch & docWord) <> "" Then
        Set oDoc = wordApp.Documents.Open(ch & docWord)
        If oDoc.Tables.Count >= 1 Then
          n = 72
          For j = 5 To 9 Step 2
            For k = 10 To 14 Step 2
              With oDoc.Tables(2).Cell(Row:=k, Column:=j).Range
                .Delete
                .InsertAfter Text:=tb1(i, n)
              End With
              n = n + 1
            Next k
          Next j
        End If
      nomFichier = ch & tb1(i, 71) & ".docx"
      If Dir(ch & tb1(i, 71) & ".docx") = "" Then oDoc.SaveAs nomFichier
      oDoc.Close
      Else
        MsgBox "Fichier " & tb1(i, 70) & " pas trouvé"
      End If
    End If
  Next i

  wordApp.Quit SaveChanges:=wdDoNotSaveChanges
  Set wordApp = Nothing

End Sub

Bonjour toutes et tous

Merci à Yal_Excel

ci-dessous à tester

Option Explicit

Sub miseJour()
  Dim ch$
  Dim tb1()
  Dim i!, j!, k!, n%
  Dim wordApp As Object
  Dim oDoc As Word.Document
  Dim docWord$, nomFichier$
  On Error Resume Next                  ' ajouter  Andre13  16112021
  tb1 = Range("Tableau1").Value2
  If tb1(i, 4) = "Xoui" Then
    Set wordApp = CreateObject("word.Application")
    With wordApp
      .Visible = True: .Activate
    End With

    For i = 1 To UBound(tb1)
      ch = tb1(i, 2) & "\"
      docWord = tb1(i, 3) & ".docx"
      If Dir(ch & docWord) <> "" Then
        Set oDoc = wordApp.Documents.Open(ch & docWord)
        If oDoc.Tables.Count >= 1 Then
          n = 5
          For j = 5 To 9 Step 2
            For k = 10 To 14 Step 2
              With oDoc.Tables(2).Cell(Row:=k, Column:=j).Range
                .Delete
                .InsertAfter Text:=tb1(i, n)
              End With
              n = n + 1
            Next k
          Next j
        End If
      nomFichier = ch & tb1(i, 4) & ".docx"
      If Dir(ch & tb1(i, 4) & ".docx") = "" Then oDoc.SaveAs nomFichier
      oDoc.Close
      Else
        MsgBox "Fichier " & tb1(i, 3) & "non trouvé"
      End If
    'End If                   '  commentaire  Andre13   16112021
  Next i

  wordApp.Quit SaveChanges:=wdDoNotSaveChanges
  Set wordApp = Nothing
  End If                     ' ajouter  Andre13  16112021
End Sub

crdlt,

André

Bonjour Andre13,

Merci pour ce complément, ça marche bien mais il fait abstraction de la condition :

 If tb1(i, 4) = "Xoui" Then 

Il créer le fichier quand même.

De plus, maintenant il enregistre les modifications dans l'ancien fichier.

Je rame aussi depuis 2 jours la dessus, en tout cas, merci pour votre temp.

Serait-il possible que si la cellule avec le nom du fichier est vide docWord = tb1(i, 3), passer au suivant ?

Andreas

re,

pour la première requête:

faut peut être regarder sur ces conditions 'si' 'aussi non' si ma mémoire est bonne une histoire de if imbriqué et si trop de if passé par une variable ce que j'ai retenu :

If, Else, ElseIf

j'ai vu un tuto de Sébastien que je passe le coucou en passant, sur ce forum à ce sujet.

https://www.excel-pratique.com/fr/vba/conditions

-----------------

pour la seconde requête:

pour l'instant aucune idée

------------

mes neurones se sont ramollis sur Excel faut que je rattrape tout çà moawww -;)

crdlt,

André

Bonsoir

Je n'avais pas les yeux en face des trous quand j'ai codé la précédente version et faute de pouvoir tester je ne me sui pas aperçu de l'erreur.

Le if qui pose problème n'est tout simplement pas à sa place. Voici la version corrigée.

Personnellement je déteste utiliser les "on error resume"

je préfère faire en sorte de gérer l'erreur possible en amont, c'est plus sûr.

Bonjour a vous,

Merci pour cette correction,

J'ai aussi réussi a intégrer la solution pour le filtrage sur la colonne 70 de ma base

après adaptation sur mon objet, je n'ai plus qu'un souci, si le document final (Colonne 71) existe déjà, il écrase l'original avec les nouvelles données

Le fichier original ne doit jamais être changé.

ça avance bien et je vous en remercie grandement

Cordialement

Andreas

Option Explicit

Sub mise_Jour()
  Dim ch$
  Dim tb1()
  Dim i!, j!, k!, n%
  Dim wordApp As Object
  Dim oDoc As Word.Document
  Dim docWord$, nomFichier$

  tb1 = Range("TablEvalUpdate1").Value2

  Set wordApp = CreateObject("word.Application")
  With wordApp
    .Visible = True: .Activate
  End With

  For i = 1 To UBound(tb1)
    If tb1(i, 70) = "" Then GoTo sivide         'Commentaire: Si la cellule est vide passe a la ligne suivante
      ch = tb1(i, 68) & "\"
      docWord = tb1(i, 70) & ".docx"
      If Dir(ch & docWord) <> "" Then
        Set oDoc = wordApp.Documents.Open(ch & docWord)
        If oDoc.Tables.Count >= 1 Then
          n = 72
          For j = 5 To 9 Step 2
            For k = 10 To 14 Step 2
              With oDoc.Tables(2).Cell(Row:=k, Column:=j).Range
                .Delete
                .InsertAfter Text:=tb1(i, n)
              End With
              n = n + 1
            Next k
          Next j
        End If
      nomFichier = ch & tb1(i, 71) & ".docx"
      If Dir(ch & tb1(i, 71) & ".docx") = "" Then oDoc.SaveAs nomFichier                'Commentaire: si vrai fermer l'original sans enregistrer
      oDoc.Close
      Else
        MsgBox "Le fichier " & tb1(i, 70) & " n'a pas été trouvé"
      End If
    'End If
sivide:

  Next i
  wordApp.Quit SaveChanges:=wdDoNotSaveChanges
  Set wordApp = Nothing

End Sub