Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBA Word Discussion :

chercher mot cle et copier cellule en face


Sujet :

VBA Word

  1. #1
    Futur Membre du Club
    chercher mot cle et copier cellule en face
    Bonjour, je me permet de poser ma question sur ce forum parce que je n'arrive pas à trouver une solution à mon problème et ma question est dans l'intitulé de la discussion, je m'explique : je voudrais chercher un mot clé dans mon document une fois trouvé (se trouve forcement dans un tableau) copier le contenu de la cellule en face et le coller ailleur.
    cela va être fait pour plusieurs cellule c pour cela la macro.
    Merci d'avance

  2. #2
    Expert éminent sénior
    Citation Envoyé par hajar1403 Voir le message

    Bonjour,

    Une solution possible à partir d'Excel :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
     
    Sub TestRecupererChaine()
     
        MsgBox RecupererChaine("C:\Users\......\MonFichierWord.docm", "B")  ' A adapter
     
    End Sub
     
    Function RecupererChaine(ByVal CheminComplet As String, ByVal TexteATrouver As String) As String
     
    ' Référencer la DLL Microsoft Word
     
    Dim wApp As Word.Application       'As Object
    Dim DocAModifier As Word.document  'As Object
    Dim I As Integer, J As Integer
    Dim Continuer As Boolean
     
       ' Application.ScreenUpdating = False
        RecupererChaine = ""
     
        Set wApp = CreateObject("Word.Application")
        With wApp
             .Visible = True
             Set DocAModifier = .Documents.Open(Filename:=CheminComplet)
             With DocAModifier
     
                  If .Tables.Count > 0 Then
                     For I = 1 To .Tables.Count
                         Continuer = True
                         For J = 1 To .Tables(I).Columns(1).Cells.Count
                           With .Tables(I).Columns(1).Cells(J)
                             If InStr(1, .Range.Text, TexteATrouver, vbTextCompare) > 0 Then
                                RecupererChaine = Mid(DocAModifier.Tables(I).Columns(2).Cells(J).Range.Text, 1, Len(DocAModifier.Tables(I).Columns(2).Cells(J).Range.Text) - 1)
                                Continuer = False
                             End If
                           End With
                         Next J
                         If Continuer = False Then Exit For
                     Next I
                  End If
                  .Close
            End With
            .Quit
        End With
     
        Set DocAModifier = Nothing
        Set wApp = Nothing
     
       ' Application.ScreenUpdating = True
     
    End Function
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

###raw>template_hook.ano_emploi###