Discussion :

[kabidan]

Bonjour
Je cherche à importer des données classées d'un fichier Excel vers un fichier Word. Voici comment cela se présente :
Dans le document Word, les noms écrits en bleu correspondent à une case de la colonne A du fichier Excel. Je souhaiterais récupérer les autres données de la ligne correspondante. Par exemple :
fichier Word : "bla bla bla Poire bla bla bla" (Poire est écrit en bleu)
fichier Excel :
----Col A -----Col B-----Col C
1---Pomme----1000-----rouge
2---Poire------100------verte
3---Orange----500------orange

--
la ligne à récupérer est celle du mot "Poire" :
Nom : Poire
Quantité : 100
Couleur : verte

Le code suivant me permet d'ouvrir le fichier Excel "test.xls" et de sélectionner les mots de couleur bleue sous Word :

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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
 
Sub ImportExcel()
 
    Application.ScreenUpdating = False
 
    Excel
 
    ActiveDocument.Content.Copy
    Call Selection.Find.ClearFormatting
    Application.ScreenUpdating = True
 
End Sub
Private Sub SetupFindObject()
    ActiveDocument.Select
 
    With Selection.Find
        .ClearFormatting
        .Text = ""
 
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
 
        .Forward = True
        .Wrap = wdFindContinue
    End With
End Sub
Private Sub Excel()
    Dim xlAppList As Excel.Application
    Dim xls As Excel.workBook
        ExcelFile = "c:\Documents and Settings\Nom\Bureau\test.xls"
        Set xlAppList = CreateObject("Excel.Application")
        Set xls = xlAppList.Workbooks.Open(ExcelFile, 0, , , "")
        Var = xls.Worksheets(1).range("C2").Value
 
            'Traitement
                Call SetupFindObject
                Selection.Find.Font.Color = wdColorBlue
 
                Do While Selection.Find.Execute
                    With Selection
                        Dim anv As String
                        anv = Selection
 
                        If InStr(1, .Text, vbCr) Then
                            .Collapse
                            .MoveEndUntil vbCr
                        End If
 
 
                        If Not .Text = vbCr Then
                        End If
 
                    End With
                Loop
 
 
        'refermer le classeur sans enregistrer
        xls.Close savechanges:=False
        Set xlAppList = Nothing
        Set xls = Nothing
End Sub

Je ne sais pas comment faire pour importer ces données. Quelqu'un peut-il me donner un coup de main ?

Merci à vous

[carden752]

Bonjour,

Peut-etre en utilisant les fonctions Match ou recherchev d'Excel afin d'avoir la position ou les valeurs correspondantes.
http://excel.developpez.com/faq/?page=Recherche

[kabidan]

Merci Carden752

=RECHERCHEV("pomme";Feuil1!$A:$B;2;FAUX) me retourne bien la valeur de la colonne B de "pomme"

Mais comment faire pour la lancer depuis Word ?

Cette macro depuis Word me permet d'importer les données 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
 
Sub Excel()
 
    Dim workBook As workBook
 
    Dim dataInExcel As String
    Application.ScreenUpdating = False
 
    Set workBook = Workbooks.Open("c:\Documents and Settings\PC\Bureau\test.xls", True, True)
    dataInExcel = workBook.Worksheets("Feuil1").range("A2").Formula
 
    Selection.TypeParagraph
 
    Selection.TypeText Text:=dataInExcel
    dataInExcel = workBook.Worksheets("Feuil1").range("A3").Formula
 
    Selection.TypeParagraph
 
    Selection.TypeText Text:=dataInExcel
    workBook.Close False
 
    Set workBook = Nothing
 
    Application.ScreenUpdating = True
 
 
End Sub

Au lieu des A2 et A3 indiqués, comment faire pour passer une variable (mots écris en bleu cité précédemment) ?

merci !

[kabidan]

Pour l'instant j'ai réussi à envoyer le mot à chercher de Word vers Excel qui retourne ensuite à Word la valeur de la colonne adjacente :

sous Word:

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
 
Option Explicit
 
Sub ExportVar() 'exporte la variable vers Excel
 
 
    Dim XlApp As Excel.Application
    Dim Xlbook As Excel.workBook
 
    Set XlApp = New Excel.Application
    XlApp.Visible = True
 
    Set Xlbook = Workbooks.Open("c:\Documents and Settings\PC\Bureau\test3.xls", True, True)
 
 
    Xlbook.Application.Run "ExcelGetVar", "pomme"   'pour l'instant, je teste sur un mot défini
    Xlbook.Activate
 
 
End Sub

Excel reçoit le mot 'poire' et retourne à Word la valeur de la colonne B adjacente (ici '100') :

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
Option Explicit
 
Sub ExcelGetVar(val As String) 'variable 'val' envoyé depuis macro Word ExportVar
 
    Dim Valeur As Variant
 
    Valeur = Application.Vlookup(val, Range("$A:$B"), 2, False)  'renvoie la colonne adjacente
 
 
 
    Dim WdApp As Word.Application
    Dim WdDoc As Word.Document
 
 
    Set WdApp = CreateObject("word.application")    'ouvre la session Word
    Set WdDoc = WdApp.Documents.Open("c:\Documents and Settings\-.PC123252888511\Bureau\test3.doc")  'ouvre le doc
 
 
    WdDoc.Application.Run "WordGetVar", Valeur
    WdDoc.Activate
 
 
End Sub

Enfin, Word affiche la valeur '100' :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Option Explicit
 
Sub WordGetVar(Valeur As String) 'variable 'Valeur' envoyée depuis macro Excel ExcelGetVar
 
    Selection.TypeText Text:=Valeur
 
    Application.ScreenUpdating = True
 
 
End Sub

Petite question : A chaque lancement, la macro ouvre de nouveaux documents word et excel en lecture seule. Y a-t-il un moyen pour ne pas créer ces nouveaux documents ? J'ai besoin d'afficher la valeur que dans le document Word original.

Si quelqu'un à une idée ?

[kabidan]

Après 2 jours de recherche, j'ai trouvé ma solution en me basant sur plusieurs scripts glanés sur le net, en particulier le site "The Word MVP Site" qui ma été beaucoup utile.

Une fois Excel ouvert par VBA sous Word, on peut utiliser les mêmes codes que sous Excel. Encore fallait-il le savoir !

Pour ceux que cela intéresse, voici mon code :

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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
 
Sub ExcelData()
 
    Dim oXL As Excel.Application
    Dim oWB As Excel.Workbook
    Dim oSheet As Excel.Worksheet
    Dim oRng As Excel.Range
    Dim ExcelWasNotRunning As Boolean
    Dim WorkbookToWorkOn As String
 
 
    WorkbookToWorkOn = "c:\Documents and Settings\PC\Bureau\test.xls" 'specify the workbook to work on
 
 
    On Error Resume Next    'If Excel is running, get a handle on it; otherwise start a new instance of Excel
    Set oXL = GetObject(, "Excel.Application")
 
    If Err Then
       ExcelWasNotRunning = True
       Set oXL = New Excel.Application
    End If
 
    On Error GoTo Err_Handler
 
    Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)    'Open the workbook
 
 
    Call SetupFindObject
    Selection.Find.Font.Color = wdColorBlue
 
    Do While Selection.Find.Execute
        With Selection
            Dim anv As String
            anv = Selection
 
            If InStr(1, .Text, vbCr) Then
                .Font.Color = RGB(51, 51, 250)
                .Collapse
                .MoveEndUntil vbCr
            End If
 
 
            If Not .Text = vbCr Then
                .Font.Color = RGB(160, 0, 210)
 
 
                 For Each oSheet In oXL.ActiveWorkbook.Worksheets    'Process each of the spreadsheets in the workbook
 
                     Dim val As String
                     Dim Colonne2 As Variant
                     Dim Colonne3 As Variant
 
                     val = Selection
                     Colonne2 = oXL.VLookup(val, Range("$A:$B"), 2, False)
                     Colonne3 = oXL.VLookup(val, Range("$A:$C"), 3, False)
 
                 Next oSheet
 
                 If ExcelWasNotRunning Then
                   oXL.Quit
                 End If
 
 
                Selection.TypeText Text:="Nom : " & val & " Quantité : " & Colonne2 & " Couleur : " & Colonne3
 
            End If
        End With
    Loop
 
 
 
    'Make sure you release object references.
    Set oRng = Nothing
    Set oSheet = Nothing
    Set oWB = Nothing
    Set oXL = Nothing
 
    'quit
    Exit Sub
 
Err_Handler:
       MsgBox WorkbookToWorkOn & " caused a problem. " & Err.Description, vbCritical, _
               "Error: " & Err.Number
       If ExcelWasNotRunning Then
           oXL.Quit
       End If
 
 
End Sub

[kabidan]

Mince, ça marchait très bien et me voilà avec "La méthode range de l'objet global a échoué". Des fois ça passe en relançant et des fois ça coince...

Quelqu'un sait remédier au problème ?

[Sepia]

Salut kabidan,

Entre les fois où ça fonctionne et où ça ne fonctionne pas, est-de que tu changes des choses (le fichier Word, le fichier Excel, des données...) ?

[kabidan]

non le plus beau c'est que je ne change rien ! (enfin je dis ça mais on ne sait jamais...)

[Heureux-oli]

Salut,

Poosible que ton fichier reste ouvert d'une exécution à l'autre.

Par contre, ton code n'est pas très "conforme".
Lorsque l'on déclare une bibliothèque dans son projet, c'est souvent pour utiliser le EalyBinding.

On affecte un obje tapplication comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim xlApp As Excel.Application
 
Set xlApp = New Execl.Application

Et pas en utilisant un objet ActiveX
comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set xlApp = CreateObject ()

[kabidan]

Effectivement, lorsque la macro fonctionne, soit elle ouvre le fichier Excel (toujours en lecture seule) soit le fichier est ouvert mais en arrière fond. Je m'en suis aperçu car je ne peux plus l'ouvrir dans ce deuxième cas. Je dois ouvrir un autre fichier Excel pour que le fichier 'text.xls', appelé dans la macro, apparaisse aussi.

Je ne saisi pas très bien les subtilités ActiveX...

[Heureux-oli]

Salut,

C'est pas une subtilité.

Ce sont deux façon de travailler différentes.

Elles ont toutes les deux des avantages et des inconvénients.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim xlApp As Object
 
Set xlApp =  CreatObject("Excel.Application")

est du LateBinding, on ne crée pas une référence à la bibliothèque au projet, le problème se situe lors de la saisie du code ou l'IntelliSense n'est pas utilisable.
Mais, on peut passer d'une version à l'autre sans problème.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim xlApp As Excel.Application
 
Set xlApp = New Excel.Application

est du EarlyBinding, on attache la bilbiothèque au projet, l'avantage est de pouvoir bénéficier de l'InstelliSense.
Mais si on change de version de bibliothèque, le projet ne fonctionne plus.

http://mhubiche.developpez.com/vba/f...endre/binding/

[kabidan]

Merci Heureux-oli pour tes explications toujours éclairées.

J'ai supprimé le bloc affichant les erreurs et l'ouverture de Excel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
    On Error Resume Next    'If Excel is running, get a handle on it; otherwise start a new instance of Excel
    Set oXL = GetObject(, "Excel.Application")
 
    If Err Then
       ExcelWasNotRunning = True
       Set oXL = New Excel.Application
    End If
 
    On Error GoTo Err_Handler

pour le remplacer uniquement par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set oXL = New Excel.Application

Cela donne une 'incompatibilité de type' à la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Selection.TypeText Text:="Nom : " & val & " Quantité : " & Colonne2 & " Couleur : " & Colonne3

incompatibilité due aux variables (l'erreur disparaît dès lors qu'il n'y a plus de variables)

Je pensais qu'il y avait un problème sur ces lignes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Colonne2 = oXL.VLookup(val, Range("$A:$B"), 2, False)
Colonne3 = oXL.VLookup(val, Range("$A:$C"), 3, False)

Mais, chose étonnante, y compris avec le problème d'incompatibilité de type (avec les variables donc), le script démarre, affiche une bonne moitié des données, puis s'arrête !

Ca paraît invraisemblable ?
merci pour toutes les suggestions

[Heureux-oli]

Salut,

La raison pour laquelle ton code bloque, je ne sais pas, mais ta variable Val n'est pas déclarée dans le dernier code complet que tu nous donnes.
Initialement, elle était transférée en argument.

[kabidan]

Merci pour t'être penché sur mon code.

la variable 'val' est bien déclarée à la ligne 49

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim val As String

Pour les tests, j'ai déclaré les variables justes avant de les employer pour savoir où exactement j'en avais besoin.

[Heureux-oli]

Salut,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim val As String

Et

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Val = Selection

ne font pas bon ménage

Selection est un objet selection.

Pour récupérer le texte d'une sélection, il faut l'utiliser.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

val = Selection.Text

[kabidan]

Bonjour
Je pense avoir cerné le problème. Il faut ajouter une condition à la recherche au cas où le mot ne figure pas dans le tableau 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
 
' Retourne la lettre de la Colonne dans laquelle apparaît le nom
Dim a As String
Dim Col As String
 
a = oXL.Range("A:C").Find(val, , xlValues, xlWhole, , , False).Address
Col = Split(a, "$")(1)
 
 
Set x = oXL.Range(Col & ":" & Col).Find(val, , xlValues, xlWhole, , , False)
On Error Resume Next
If Not x Is Nothing Then
   Colonne2 = oXL.VLookup(val, Range(Col & ":$B"), 2, False)
   Colonne3 = oXL.VLookup(val, Range(Col & ":$C"), 3, False)
Else:
   Colonne2 = "vide"
   Colonne3 = "vide"
End If