Discussion :

[krokos55]

bonjour,

je cherche de l'aide car j'essaie de copier une cellule excel 07 dans un signet word 07 grâce à une macro et cela ne fonctionne pas:

voila le code VBA que j'utilise:

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
Sub export_donnees()
Dim WordObj As Object
On Error Resume Next
 
 
Set WordApp = CreateObject("word.application") 'ouvre session word et le fichier voulu
Set WordDoc = WordApp.Documents.Open("C:\Documents and Settings\Bureau\Lettre") 'ouvre document Word
WordApp.Visible = False 'word masqué pendant l'operation
 
'dans le document word, il faut avoir placé des signets aux endroits qu'on veut remplir
'à l'endroit de chaque signet qui se trouve dans le fichier word on va inscrire le contenu des cellules
WordDoc.Bookmarks("Monsignet").Range.Text = Range(A1)
WordDoc.Bookmarks("Monsignet2").Range.Text = Range(b1)
 
 
WordApp.Visible = True 'affiche le document Word
 
End Sub

Le doc word existe sur mon bureau, il s'ouvre mais les deux signet que j'ai défini dans word ( Monsignet et Monsignet1 ) ne change pas en utilisant ce qu'il y a dans les cellule A1 et B1 du doc excel ouvert

merci bcp pour votre aide

[kiki29]

Salut, une version qui écrit dans les Signets Word s'il y a une cellule nommée
de même nom dans le fichier 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
Option Explicit
 
Sub Excel_WordBmk()
Dim AppWord As Object
Dim DocWord As Object
Dim Wkb As Workbook
Dim NomCell As Excel.Name
Dim sChemin As String
 
    Set Wkb = ThisWorkbook
    sChemin = ThisWorkbook.Path & "\" & "Test1.dot"
 
    On Error GoTo Erreurs
    Set AppWord = CreateObject("Word.Application")
    Set DocWord = AppWord.Documents.Add(sChemin)
 
    For Each NomCell In Wkb.Names
        If DocWord.Bookmarks.Exists(NomCell.Name) Then
            DocWord.Bookmarks(NomCell.Name).Range.Text = Feuil1.Range(NomCell.Value)
        End If
    Next NomCell
 
    DocWord.SaveAs Filename:=ThisWorkbook.Path & "\" & "Test.doc"
    DocWord.Close
 
Retour:
    If Not AppWord Is Nothing Then AppWord.Quit False
    Set AppWord = Nothing
    Exit Sub
 
Erreurs:
    MsgBox Err.Number & vbCrLf & Err.Description
    Resume Retour
End Sub

[Theze]

Bonjour,

Voici une piste :

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
 
Sub ExcelVersWord()
 
    Dim AppWord As Object
    Dim Doc As Object
 
    'crée une instance de Word
    Set AppWord = CreateObject("Word.Application")
 
    With AppWord
 
        .Visible = True
 
        'ouvre un document, ATTENTION de mettre l'extension ".doc"
        Set Doc = .Documents.Open("C:\Documents and Settings\Bureau\Lettre.doc")
 
        With Doc
 
            'faire le choix dans les deux méthodes (ou les deux) :
 
            'insère le texte des cellules A1 et B1 après les signets
            .Bookmarks("Monsignet").Range.InsertAfter Range("A1")
            .Bookmarks("Monsignet2").Range.InsertAfter Range("B1")
 
            'remplace les signets par les textes des cellules A1 et B1
            .Bookmarks("Monsignet").Range.Text = Range("A1")
            .Bookmarks("Monsignet2").Range.Text = Range("B1")
 
 
        End With
 
    End With
 
End Sub

Hervé.

[krokos55]

Merci a vous deux pour vos pistes !
Comment cela se passe si le fichier excel a un nom différent du fichier word ?

merci bcp

[kiki29]

Salut, rien du tout, cela fonctionne indépendamment du nom du classeur, sur mon exemple il prend en compte le CodeName de la Feuil1, qui par défaut dans un nouveau classeur est le même que le nom d'onglet.

Dans la Feuil1 d'Excel
Par exemple en A1 Civilite, A2 Nom, A3 Prenom etc
En B1:Bxy les valeurs correspondantes
Chacune de ces cellules B1:Bxy sont nommées : Civilite,Nom,Prenom etc
Pour le Modele *.dot ou *.doc des signets sont à insérer avec les mêmes noms : Civilite,Nom,Prenom etc

Pour obtenir la liste des bookmarks/signets d'un doc 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
Option Explicit
 
Sub Liste_Bmks()
Dim AppWord As Object
Dim DocWord As Object
Dim bmk As Object
Dim sChemin As String
Dim i As Long
Dim FD As FileDialog
 
    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    With FD
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Documents Word", "*.doc*; *.dot*", 1
        If .Show <> -1 Then Exit Sub
        sChemin = .SelectedItems(1)
    End With
 
    With Feuil2
        .Activate
        .Cells.Clear
    End With
 
    Application.ScreenUpdating = False
    Set AppWord = CreateObject("Word.Application")
    Set DocWord = AppWord.Documents.Open(Filename:=sChemin)
 
    i = 0
    For Each bmk In DocWord.Range.Bookmarks
        i = i + 1
        Feuil2.Range("A" & i) = bmk.Name
    Next bmk
 
    AppWord.Quit
    Set DocWord = Nothing
    Set AppWord = Nothing
 
    Feuil2.Range("B1").Select
    Application.ScreenUpdating = True
End Sub