Automatiser Copier Coller entre Word et Excel

Bonjour

Voila J'ai un tableau excel dont je dois remplir les deux dernieres colonnes avec des données contenues dans un fichier différent (dont j'ai accès et dont le nom se trouve dans chaque ligne) pour chaque ligne.

J'ai écrit l'algorithme de ce que je voudrais faire :

Variables:

i est le numéro de ligne dans le tableau excel.

Lx est le numéro de la ligne dans le tableau word

Début algorithme:

i prend la valeur 3 \\ corespond à ma ligne de départ dans le tableau

Tant que Lx < 1627 \\ 1627 correspond au nombre de lignes dans le tableau à remplir

• Copier dans la ligne Lx la colonne I

Chercher dans le répertoire M****o le nom collé

Si

Il y a plusieurs fichiers correspondants, passer à la ligne suivante

Sinon

ouvrir le dossier word correspondant \\ dans le fichier word se trouve un tableau

Pour Lx allant de 8 à 10, faire \\ Lx corespond au numéro de ligne dans le tableau

Chercher à la ligne Lx le mot clé "Consignes"

Fin Pour si le mot clé est trouvé

Lx prend la valeur Lx+1

Fin Si

Si

Dans la ligne Lx sur la ligne ou se trouve "consignes" si on trouve le mot clé "Critique", copier "Critique" dans la colonne P à la ligne i

Sinon

Copier "Absent" dans la colonne P à la ligne i

Fin Si

Si

dans la ligne Lx il y a du texte, le copier dans la colonne Q à la ligne i

Sinon

Copier "Absent" dans la colonne Q à la ligne i

Fin Si

• Exécuter i prend la valeur i+1

Fin algorithme

J'ai commencé la rédaction du code:

Sub Importation_Donnees_Word()

    ' -- Déclaration des variables
    Dim wb As Workbook          'classeur Excel dans lequel on importe les données
    Dim ws As Worksheet         'onglet Excel dans lequel on importe les données
    Dim sChemin As String       'répertoire contenant les fichiers Word
    Dim sNomFichier As String   'nom du fichier Word
    Dim WApp As Object, WDoc As Object, WSel As Object
    Dim i As Integer

    ' -- Initialisation des variables
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)                       'on sauvegarde dans la 1re feuille
    sChemin = ChoisirRepertoire & "J:\200 - Applications_ISY\20.33 - Advantage\Antoine\NSM - Monaco\Monaco\"    'fonction pour choisir le répertoire contenant les fichier Word
    sNomFichier = Dir(sChemin & "*.doc*")       'pour ouvrir tous les fichiers .doc*. 1er fichier.

    Set WApp = CreateObject("Word.Application") 'pour créer un objet Word
    WApp.Visible = True                        'ne pas afficher Word pendant l'exécution
    i = 3   '1re ligne où on va écrire les données dans le fichier Excel

    Application.ScreenUpdating = False

    ' -- Boucle sur les fichiers
        While i < 1627 'Nombre total de ligne à remplir
        ' Nom du fichier

        sNomFichier = Dir(sChemin & (ws.Cells(i, 9).Value))

        Set WDoc = WApp.Documents.Open(sChemin & sNomFichier)   'ouvre le document Word
        Application.StatusBar = "Écriture ligne " & i       'message dans Excel pour voir la progression

Wend 

End Sub

Pour l'instant j'ai plusieurs pb:

Avec la commande

sNomFichier = Dir(sChemin & (ws.Cells(i, 9).Value))

, j'ai réussi à ouvrir le bon fichier, mais j'avais mis le nom complet dans la cellule correspondante.

Or normalement, le nom n'est pas complet. Et si j'execute cette ligne en remettant ce qu'il y a dans la cellule normalement, le programme ne trouve pas le document.

Existe-t-il une manière pour dire à ma commande de chercher les documents qui contiennent les caractères de la cellule et non de dire à la commande que le nom du doc est ce qu'il y a dans la cellule ?

Aussi, il se peut que pour ce que contient la cellule, cela renvoie à plusieurs fichiers au lieu d'un. Ainsi j'aimerais que si le nombre de fichiers correspondants est supérieur à 1, on passe directement à la ligne suivante. Comment puis je le mettre dans mon programme ?

Il y a quelqu'un ?

Rechercher des sujets similaires à "automatiser copier coller entre word"