Discussion :

[avigeilpro]

Bonjour tout le monde.
j'aurais voulu savoir où je pouvais trouver des exemples d'utilisation de la référence Microsoft Word (permettant de traiter les fichier .doc) sachant que je sais comment ouvrir le document (déclaration des variables et utilisation du Set) mais il me manque tout le reste
Merci d'avance

[zazaraignée]

Salut

Il me semble que l'arborescence des objets de Word est documentée dans l'aide de VBA de Word. Tu peux aussi utiliser l'explorateur d'objets de VB (la touche F2). Déroule la liste <Toutes les librairies> (ou All Libraries) et choisis Word. Tu devrias trouver tout ce que tu as besoin. Ensuite tu sélectionnes un objet, paragraph par exemple, et une propriété (ou méthode ou événement), Format par exemple et tu cliques sur le bouton avec le point d'interrogation. La rubrique d'aide correspondante s'ouvrira illico!

Bonnes fouilles!

[avigeilpro]

Ca ne marche pas, il me renvoie 'Impossible d'afficher l'aide'. Mais n'y aurait-il pas un endroit ou je pourais trouver un exemple ou des explications détaillées ?

[ouskel'n'or]

Hello,
Si tu n'as pas l'aide, il est possible qu'il te manque une référence "Outils -> Références". (pas vérifié (!) puisque j'ai l'aide...)
Quand tu installes Office, c'est une option. Tu vérifies.

A+

[avigeilpro]

j'ai pas tout compris, peux tu m'expliquer plus précisément ce que je dois vérifier ?? merci d'avance

[AlainTech]

Pour comprendre et t'aider, il faut que tu nous en dises un peu plus.

En quoi programmes-tu?

Office est-il installé sur la machine où tu développes?

[zazaraignée]

Salut

Si tu n'as pas installé l'aide de VBA de Office, c'est certain que tu ne pourras pas l'afficher. Par défaut, l'aide de VBA n'est pas installée.

[SilkyRoad]

bonjour

ci joint quelques exemples pour piloter Word depuis Excel


Ouvrir un document Word existant à partir d'Excel
**************************************

Code :

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

1
2
3
4
5
6
7
8
9
Sub ouvrirDocWordExistant()
'necesite d'activer la reference Microsoft Word xx.x Object Library
Dim appWrd As Word.Application
Dim docWord As Word.Document
Set appWrd = createObject("Word.Application")
appWrd.Visible = True
Set docWord = appWrd.Documents. _
Open("C:\mes documents\monDocument.doc", readOnly:=True)
End Sub

Créer un nouveau document Word à partir d'Excel
*****************************************

Code :

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

1
2
3
4
5
6
7
8
9
Sub ouvrirNouveauDocWord()
'necesite d'activer la reference Microsoft Word xx.x Object Library
Dim appWrd As Word.Application
Dim docWrd As Word.Document
Set appWrd = createObject("Word.Application")
appWrd.Visible = True
Set docWrd = appWrd.Documents.Add
docWrd.SaveAs "C:\monDocument.doc"
End Sub

Compter le nombre de pages d'un document 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
Sub compterNombrePagesDocWord()
Dim wrdApp As Object, wrdDoc As Object
Dim nbPage As Byte
Dim Ouvrir As String
Ouvrir = Application.getOpenFilename("Fichiers Word (*.doc), *.doc")
Set wrdApp = createObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open(Ouvrir)
WrdDoc.Bookmarks("\endofdoc").Select
With wrdDoc
nbPage = .builtinDocumentProperties("Number of Pages")
msgBox "Il y a " & nbPage & " page(s) dans le document Word : " & Chr(10) & Ouvrir
.Close
End With
wrdApp.Quit
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub

Importer la totalité d'un document Word dans une feuille 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
Sub ImporterWordVersExcel()
'necessite d'activer la reference microsoft Word xx.x Object Library
Dim DocWord As Word.Document
Dim AppWord As Word.Application
Dim Wb As Workbook
 
Set Wb = Workbooks.Add(1)
Set AppWord = New Word.Application
AppWord.Visible = False
Set DocWord = _
AppWord.Documents.Open("C:\monDocument.doc", ReadOnly:=True)
 
With AppWord
.Selection.WholeStory
.Selection.Copy
End With
 
Wb.ActiveSheet.Range("A1").Select
Wb.ActiveSheet.Paste
AppWord.Application.Quit
Application.CutCopyMode = False
Wb.SaveAs "C:\copieDocument.xls"
End Sub

Lister les propriétés d'un document 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
Sub ProprietesDocWord()
Dim WrdApp As Object, WrdDoc As Object, Propriete As Object
Dim Ouvrir As String
Dim Ligne As Byte
 
On Error Resume Next
Ouvrir = "C:\Documents and Settings\michel\fichier.doc" 'adapter chemin
 
Set WrdApp = CreateObject("Word.Application")
WrdApp.Visible = False
Set WrdDoc = WrdApp.Documents.Open(Ouvrir)
 
For Each Propriete In WrdDoc.BuiltinDocumentProperties
Ligne = Ligne + 1
Cells(Ligne, 1) = Propriete.Name
Cells(Ligne, 2) = Propriete.Value
Next
 
WrdDoc.Close
WrdApp.Quit
End Sub

Insérer , redimensionner et positionner une image dans un document Word existant
***************************************************************

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 InsertImageDansDocWord()
'activer la reference Microsoft Word 10.0 Object Library
Dim WrdApp As Word.Application
Dim WrdDoc As Word.Document
Dim Fichier As String
 
On Error Resume Next
Fichier = "C:\Documents and Settings\michel\dossier\general\excel\testpilotageWord.doc"
 
Set WrdApp = CreateObject("Word.Application")
WrdApp.Visible = True
Set WrdDoc = WrdApp.Documents.Open(Fichier) 'ouvrir le document Word
 
WrdDoc.InlineShapes.AddPicture Filename:= _
"C:\Documents and Settings\michel\Mes documents\Mes images\PICT1037.JPG" 'adapter le chemin de l'image à insérer
On Error GoTo 0
 
With WrdDoc.InlineShapes(1) 'adapter l'index si d'autres images existantes dans le document
.Height = 190.75 'changement dimension image insérée : hauteur
.Width = 254# 'largeur
.ConvertToShape
End With
 
With WrdDoc.Shapes(1)
.Top = 200 'position verticale de l'image dans le document
.Left = 150 'position horizontale de l'image dans le document
.ZOrder msoBringInFrontOfText 'image au premier plan devant le texte
'.ZOrder msoSendBehindText 'option pour image en arriere plan derriere le texte
End With
 
'WrdDoc.Close 'fermer le document Word
'WrdApp.Quit 'fermer l'application Word
 
End Sub

Coller dans Word une selection de cellules , au format image Bitmap
********************************************************

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
Sub CollerDansWordFormatBitmap()
'necessite d'activer la reference microsoft Word xx.x Object Library
Dim Wrd As Word.Application
 
Selection.Copy
 
Set Wrd = CreateObject("Word.Application")
On Error Resume Next
Wrd.Documents.Add
Wrd.Visible = True
 
Wrd.Selection.PasteSpecial DataType:=wdPasteBitmap
Application.CutCopyMode = False
 
End Sub

Modifier les marges dans un document 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
Sub MargesDansWord()
'activer la reference Microsoft Word xx.x Object Library
Dim Wrd As Word.Application
Set Wrd = CreateObject("Word.Application")
Dim AppWrd As Word.Document
Dim j As Byte
 
Set AppWrd = Wrd.Documents.Add
Wrd.Visible = True
 
With AppWrd.PageSetup
.LeftMargin = 12.7
.RightMargin = 6.8
.TopMargin = 9.5
.BottomMargin = 9.5
End With
 
End Sub

Controler si l'application Word est ouverte
**********************************

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub ControleSiWordOuvert()
Dim Appli As Word.Application
'testé avec Excel97
'nécéssite d'activer la reference Microsoft word xx.x 0bject Library
On Error Resume Next
Set Appli = GetObject(, "Word.Application")
If Appli Is Nothing Then
MsgBox "Word est fermé"
Else
MsgBox "Word est ouvert"
Appli.Quit 'fermeture application Word
End If
End Sub

Modifier l'entete ou le pied de page d'un document Word depuis 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
Sub enteteEtPiedDePageWord()
'necessite d'activer la reference microsoft Word xx.x Object Library
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Dim Fichier As String
Fichier = "C:\Documents and Settings\michel\Doc2.doc" 'adapter le chemin
Set wordApp = createObject("Word.Application")
wordApp.Visible = True
Set wordDoc = wordApp.Documents.Open(Fichier)
With wordDoc.Sections(1)
.Headers(wdHeaderFooterPrimary).Range.Text = "Le titre"
.Headers(wdHeaderFooterPrimary).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Footers(wdHeaderFooterPrimary).pageNumbers.Add
End With
End Sub

Accepter toutes les révisions dans le document Word , sauf les suppressions
***************************************************************

Code :

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

1
2
3
For i = 1 To wordDoc.Revisions.Count 
If wordDoc.Revisions(i).Type <> wdRevisionDelete Then wordDoc.Revisions(i).Accept
Next

Ajouter une colonne dans le tableau d'un document Word
***********************************************

macro qui insère une nouvelle colonne en 3eme position dans le 2eme tableau d'un document Word .
la premiere cellule de cette nouvelle colonne est coloriée en bleu et un texte y est inséré

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
Private Sub CommandButton1_Click()
'nécéssite d'activer la référence Microsoft Word xx.x Object Library
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim Fichier As String
 
'le document Word est supposé fermé avant le lancement de la macro
'adapter le chemin
Fichier = "C:\Documents and Settings\michel\fichierWord.doc"
Set WordApp = CreateObject("Word.Application") 'creation session Word
WordApp.Visible = False 'pour que word reste masqué pendant l'opération
Set WordDoc = WordApp.Documents.Open(Fichier) 'ouverture du fichier Word
 
'insertion d'une colonne en 3eme position dans le 2eme tableau du document Word
'colorie en bleu la 1ere cellule dans la colonne insérée
With WordDoc.Tables(2)
.Columns.Add BeforeColumn:=WordDoc.Tables(2).Columns(3)
.Columns(3).Cells(1).Shading.BackgroundPatternColorIndex = wdBlue 'fond de cellule en bleu
.Columns(3).Cells(1).Range.Text = "le forum xld" 'texte dans la cellule
.AutoFitBehavior wdAutoFitWindow ' adapte la dimension du tableau à la feuille
End With
 
WordDoc.Close True 'ferme le document Word en sauvegardant les modifications
WordApp.Quit 'ferme l'application Word
End Sub

Insérer une image dans la 3eme cellule de la 2eme colonne , d'un tableau 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
Sub insereImageDansCelluleTableauWord()
'nécéssite d'activer la référence Microsoft Word xx.x Object Library
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Set wordApp = createObject("word.application") 'ouvrir une session Word
Set wordDoc = wordApp.Documents.Open(thisWorkbook.Path & "\leFichier.doc") 'ouvrir un document
'insérer une image dans la 3eme Cellule de la 2eme colonne (dans le
'1er tableau d'un document Word )
wordDoc.Tables(1).Columns(2).Cells(3).Range.inlineShapes.addPicture Filename:= _
"C:\program files\microsoft office\media\cagcat10\j0149481.wmf", _
linkToFile:=False, saveWithDocument:=True
With wordDoc.inlineShapes(wordDoc.inlineShapes.Count)
.Height = 150 'redimensionne hauteur image
.Width = 150 'redimensionne largeur image
End With
wordApp.Visible = True 'affichier le document Word
End Sub

Imprimer un document Word
***********************
ouvre un fichier Word ( en mode masqué ) , lance l'impression et referme le document

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
Sub ouvrirDocWord_Impression()
'necesite d'activer la reference Microsoft Word xx.x Object Library
Dim appWrd As Word.Application
Dim docWord As Word.Document
Dim Fichier As String
 
Fichier = "C:\Documents\monDocument.doc"
 
Set appWrd = CreateObject("Word.Application") 'creation session Word
appWrd.Visible = False 'pour que word reste masqué pendant l'operation
Set docWord = appWrd.Documents.Open(Fichier)
 
docWord.PrintOut 'impression
 
docWord.Close 'fermer le document Word
appWrd.Quit 'fermer la seesionWord
End Sub

Fusionner des cellules dans un tableau Word
*************************************

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub fusionnerCellsDansTableauWord()
'activate Microsoft Word xx.x Object Library
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Set wordApp = createObject("word.application") 'Word Session
Set wordDoc = wordApp.Documents.Open("C:\monDocument.doc") 'ouverture Doc
wordApp.Visible = True
'fusionner les Cells(2,3) à Cells(3,5) dans le premier tableau du document Word
wordDoc.Tables(1).Cell(Row:=2, Column:=3).Merge _
mergeTo:=wordDoc.Tables(1).Cell(Row:=3, Column:=5)
End Sub

Importer les données provenant de plusieurs tableaux 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
Sub importValuesFromWordTables()
'Activer reference Microsoft Word xx.x Object Library 
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Dim i As Byte, j As Byte
Set wordApp = createObject("word.application") 
wordApp.Visible = False
Set wordDoc = wordApp.Documents.Open(thisWorkbook.Path & "\monFichier.doc") 
'dans 3 tables Word du document , importer 5 valeurs de la premiere colonne 
'importer les données de chaque table dans une feuille différente
For i = 1 To 3 
For j = 1 To 5 
activeWorkbook.Sheets(i).Cells(j, 1) = wordDoc.Tables(i).Columns(1).Cells(j)
Next j
Next i
wordDoc.Close 
wordApp.Quit 
End Sub

Copier une ligne precise d'un tableau word et le coller dans 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
Sub importValeurs_De_WordTables()
'Activer la reference Microsoft Word xx.x Object Library 
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
 
Set WordApp = CreateObject("word.application")
WordApp.Visible = False 'Word reste masqué pendant l'opéraion
Set WordDoc = WordApp.Documents.Open("C:\monDocument.doc") 'ouvre le document Word
 
'copies la 3eme ligne de la 1ere table Word
WordDoc.Tables(1).Rows(3).Range.Copy
 
'collage dans Excel
Range("A1").PasteSpecial xlPasteValues
 
WordDoc.Close 'fermeture document Word
WordApp.Quit 'fermeture session Word
End Sub

Exporter des donneés excel dans des cellules precises d'un tableau 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
Sub exportValeursExcelVersTableWord() 
'Necessite d'activer la reference Microsoft Word xx.x Object Library 
Dim wordApp As Word.Application 
Dim wordDoc As Word.Document 
 
Set wordApp = CreateObject("word.application") 
wordApp.Visible = True 'mettre False pour garder Word masqué 
Set wordDoc = wordApp.Documents.Open("C:monDocument.doc") 'ouvre le document Word 
 
'Tables(2) correspond au 2eme tableu du document Word 
'transfert la donnée de la cellule A1 dans la 3eme cellule de la 1ere colonne 
wordDoc.Tables(2).Columns(1).Cells(3).Range.Text = Range("A1") 
 
'transfert la donnée de la cellule A2 dans la 2eme cellule de la 3eme colonne 
wordDoc.Tables(2).Columns(3).Cells(2).Range.Text = Range("A2") 
 
'wordDoc.Close True 'ferme le document Word en enregistrant les modifications 
'wordApp.Quit 'ferme l'application Word 
End Sub

Exporter des données Excel vers plusieurs signets d'un document Word
**********************************************************

la macro ci-dessous permet d'exporter les valeurs des cellules A1 à A3 vers des signets d'un document word nommé "monfichier.doc"
dans l'exemple , les signets positionnés aux endroits de ton choix doivent etre nommés "Signet1 , signet2 et Signet3

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
Sub exportDonneesDansSignetsWord()
'nécéssite d'activer la référence Microsoft Word xx.x Object Library
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim i As Byte
 
Set WordApp = CreateObject("word.application") 'ouvre session word
Set WordDoc = WordApp.Documents.Open("C:\Documents and Settings\michel\monFichier.doc") 'ouvre document Word
WordApp.Visible = False 'word masqué pendant l'operation
For i = 1 To 3
'les signets du document Word sont nommés Signet1 , Signet2 , Signet3
WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(i, 1)
Next i
 
WordApp.Visible = True 'affiche le document Word
'WordDoc.PrintOut 'imprimer
 
'WordDoc.Close True 'ferme le document word en sauvegardant les données
'WordApp.Quit 'ferme la session Word
End Sub

Afficher des informations sur la version de Word installée
***********************************************

Code :

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

1
2
3
4
5
6
7
8
Sub informationsVersionWord()
Dim objWord As Object
Dim Resultat As String
Set objWord = CreateObject("Word.Application")
Resultat = "Version: " & objWord.Version & vbLf & _
"Build: " & objWord.Build & vbLf & "Product Code: " & objWord.ProductCode()
MsgBox Resultat
End Sub

Boucler sur les paragraphes d'un document Word et les supprimer s'ils débutent par le mot "Test"
*************************************************************

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
Option Compare Text
Sub supprimerParagraphe()
Dim WordApp As Word.Application
Dim WordDoc As Word.document
Dim cible As Paragraph
 
Set WordApp = New Word.Application
WordApp.Visible = True
 
Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\Doc1.doc")
WordDoc.bookmarks("\StartOfDoc").Select
 
For Each cible In WordDoc.Paragraphs
cible.Range.Select
If Trim(cible.Range.Words(1)) = "Test" Then cible.Range.Delete
Next cible
End Sub

Un autre exemple qui supprime les paragraphes de façon conditionnelle

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 supprimerParagraphes_Conditionnel()
'boucle sur les 3 premiers paragraphes du document Word :
'si la cellule A1<>1 alors suppression du paragraphe 1
'si la cellule A2<>1 alors suppression du paragraphe 2
'si la cellule A3<>1 alors suppression du paragraphe 3
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim i As Integer
 
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open("C:\monDocument.doc")
 
For i = 3 To 1 Step -1
If Cells(i, 1) <> 1 Then _
WordDoc.Paragraphs.Item(i).Range.Delete
Next i
End Sub

Inserer la date du jour dans un signet Word , nommé "SignetDate"
******************************************************

Code :

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

1
2
3
4
5
6
7
8
9
Sub miseAjourSignetDocWord()
'necessite d'activer la reference Microsoft Word xx.x Object Library
Dim WordApp As Word.Application
Dim WordDoc As Word.document
Set WordApp = New Word.Application
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\monDocument.doc")
WordDoc.Bookmarks("SignetDate").Range.Text = Format(Now, "dd/mm/yyyy")
End Sub

Remplacer une macro dans tous les modèles Word .DOT d'un répertoire
**********************************************************
( procédure VBA 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
Sub remplacement_Macro_WordDot() 
'<a href="http://www.developpez.net/forums/viewtopic.php?p=2011706#2011706" target="_blank">http://www.developpez.net/forums/vie...011706#2011706</a>
Dim Debut As Integer, Lignes As Integer, X As Integer 
Dim Fichier As String, Direction As String 
Dim Doc As Document 
 
Application.ScreenUpdating = False 
 
'boucle sur tous les fichiers .dot du repertoire 
Direction = "C:\Documents and Settings\michel\dossier\general\excel" 
Fichier = Dir(Direction & "\*.dot") 
Do While Fichier <> "" 
 
Set Doc = Documents.Open(Direction & "\" & Fichier) 
 
    'suppression macro nommée "essai" dans module1 
    With Doc.VBProject.VBComponents("Module1").CodeModule 
    Debut = .ProcStartLine("essai", 0) 
    Lignes = .ProcCountLines("essai", 0) 
    .DeleteLines Debut, Lignes 
    End With 
 
    'ajout macro nommée "MaNouvelleMacro" dans Module1 
    With Doc.VBProject.VBComponents("Module1").CodeModule 
    X = .CountOfLines 
    .InsertLines X + 1, "Sub MaNouvelleMacro()" 
    .InsertLines X + 2, "MsgBox ""Coucou"",VBinformation " 
    .InsertLines X + 3, "End Sub" 
    End With 
 
DoEvents 
Doc.Close True 
Set Doc = Nothing 
 
Fichier = Dir 
Loop 
Application.ScreenUpdating = True 
End Sub

Récupérer la donnée d'un champ de fusion , dans un document Word ouvert
*************************************************************

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
Sub recupValeurChampFusion_DocumentWordOuvert()
Dim Appli As Word.Application
Dim WordDoc As Word.Document
'nécéssite d'activer la reference Microsoft word xx.x 0bject Library
 
On Error Resume Next
Set Appli = GetObject(, "Word.Application")
Set WordDoc = Appli.Documents("C:\Documents and Settings\michel\leDocument.doc")
 
If WordDoc Is Nothing Then
MsgBox "Le document est fermé"
Else
MsgBox WordDoc.MailMerge.DataSource.DataFields("N_Devis").Value
End If
End Sub

Transferer un tableau Excel vers Word et l'adapter à la largeur de la page
************************************************************

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
Sub EnvoyerTableauxExcelVersWord_V02()
'necessite d'activer la reference Microsoft Word xx.x Object Library
Dim DocWord As Word.Document
Dim AppWord As Word.Application
 
Set AppWord = New Word.Application
AppWord.Visible = True
Set DocWord = AppWord.Documents.Add
 
Range("A1:H10").Copy
 
AppWord.Selection.Paste
DocWord.Tables(1).AutoFitBehavior wdAutoFitWindow
 
Application.CutCopyMode = False
End Sub

Lancer une macro Word depuis Excel
******************************

Code :

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

1
2
3
4
5
6
7
8
Sub lancerMacroWord()
Dim wordApp As Word.Application
 
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
wordApp.Documents.Open ("C:\monDocument.dot")
wordApp.Run "laMacro"
End Sub

Pour piloter un document Word déjà ouvert , utilisez la fonction getObject :
******************************************************

Code :

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

1
2
3
4
5
6
Sub piloterUnDocumentWordOuvert()
'Activer reference Microsoft Word xx.x Object Library
Dim wordDoc As Word.Document
Set wordDoc = GetObject("C:\monFichier.doc")
MsgBox wordDoc.paragraphs.Count 
End Sub

Importer un tableau Word vers Excel en intégrant les retours à la ligne
*********************************************************

Les retours à la ligne dans les cellules d'un tableau Word génèrent autant de cellules supplémentaires lors du collage dans Excel
Pour y remédier , cet exemple importe vers Excel le premier tableau du document Word "C:\monFichier.doc" ( qui est déja ouvert) , en conservant le format des cellules

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
Sub importerValeursTableWord_VersExcel()
Dim wordDoc As Object
Dim i As Integer , j As Integer
Dim Cible As Variant
 
Set wordDoc = GetObject("C:\monFichier.doc")
For i = 1 To wordDoc.Tables(1).Rows.Count
For j = 1 To wordDoc.Tables(1).Columns.Count
Cible = wordDoc.Tables(1).Columns(j).Cells(i)
 
Sheets(1).Cells(i, j) = _
Application.WorksheetFunction.Substitute(Cible, vbCr, vbLf)
Sheets(1).Cells(i, j) = _
Left(Sheets(1).Cells(i, j), Len(Sheets(1).Cells(i, j)) - 1)
Next j
Next i
End Sub

Insérer des données dans un champ personnalisé Word
**********************************************

Code :

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

1
2
'Fields(1) : premier champ du document Word %%%
WordDoc.Fields(1).Result.Text = "essai d'ecriture dans champ Word"

Lire les données d'un champ personnalisé Word
***************************************

Code :

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

1
2
'Fields(1) : premier champ du document Word
MsgBox WordDoc.Fields(1).Result.Text

Vérifier si la premiere cellule d'un tableau est "vide"
******************************************

Code :

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

1
2
3
4
5
6
'Chr(13) & Chr(7)sont des caracteres qui apparaissent par defaut dans les cellules lors de la creation du tableau
If wordDoc.Tables(1).Columns(1).Cells(1).Range.Text = Chr(13) & Chr(7) Then 
MsgBox "Cellule vide" 
Else 
MsgBox "Cellule non vide" 
End If

Extraire les phrases / lignes de plusieurs documents Word
************************************************

Chaque ligne est importée dans une colonne différente du classeur

la macro Excel boucle sur tous les documents Word (fermés) pour
ouvrir les fichiers
transferer chaque phrase/ligne dans une colonne differente du classeur
puis refermer le document

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
Sub importLignesDocumentWord()
Dim Fichier As String, Direction As String
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Dim i As Byte
Dim j As Integer
 
Application.ScreenUpdating = False
 
Direction = ThisWorkbook.Path
Fichier = Dir(Direction & "\*.doc")
Do While Fichier <> "" 'boucle sur tous les fichiers .doc du repertoire
 
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = False
Set wordDoc = wordApp.Documents.Open(Direction & "\" & Fichier) 'ouverture documents word
j = j + 1
For i = 1 To wordDoc.Sentences.Count 'boucle sur les phrases/lignes de chaque document
Cells(j, i) = _
Application.WorksheetFunction.Substitute(wordDoc.Sentences(i).Text, Chr(13), "")
Next i
 
wordDoc.Close False 'fermeture documents word
wordApp.Quit
Set wordDoc = Nothing
Set wordApp = Nothing
Fichier = Dir
 
Loop
End Sub

cordialement
michel

[u.dossa.12]

 

Merci pour ces exemples, mais dans le cas contraire est ce que ça marche pareil aussi; je veux dire pour piloter Excel depuis Word

[moiajamoi]

Bonjour tout le monde pouvez m'aider à automatiser le code suivant :

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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Sub Tempo_filled_in()
'
' Tempo_filled_in Macro
'
 
'Necessite d'activer la reference Microsoft Word xx.x Object Library
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
 
Set wordApp = CreateObject("word.application")
wordApp.Visible = True 'mettre False pour garder Word masqué
 
Set wordDoc = wordApp.Documents.Open("Y:\2019\doc\automation\Doc\word form.docx", ReadOnly:=False) 'ouvre le document Word
 
'Tables(1) correspond au 1eme tableau du document Word
'transfert la donnée de la cellule A1 dans la 2eme cellule de la 1ere colonne
wordDoc.Tables(1).Columns(1).Cells(2).Range.Text = Range("A2")
wordDoc.Tables(1).Columns(1).Cells(2).Shading.BackgroundPatternColorIndex = wdBlue 'fond de cellule en bleu
 
'transfert la donnée de la cellule B2 dans la 2eme cellule de la 2eme colonne
wordDoc.Tables(1).Columns(2).Cells(2).Range.Text = Range("B2")
wordDoc.Tables(1).Columns(2).Cells(2).Shading.BackgroundPatternColorIndex = wdBlue 'fond de cellule en bleu
 
'transfert la donnée de la cellule C2 dans la 4eme cellule de la 1eme colonne
wordDoc.Tables(1).Columns(1).Cells(4).Range.Text = Range("C2")
wordDoc.Tables(1).Columns(1).Cells(4).Shading.BackgroundPatternColorIndex = wdBlue 'fond de cellule en bleu
 
'transfert la donnée de la cellule D2 dans la 4eme cellule de la 2eme colonne
wordDoc.Tables(1).Columns(2).Cells(4).Range.Text = Range("D2")
wordDoc.Tables(1).Columns(2).Cells(4).Shading.BackgroundPatternColorIndex = wdBlue 'fond de cellule en bleu
 
'transfert la donnée de la cellule E2 dans la 6eme cellule de la 1eme colonne
wordDoc.Tables(1).Columns(1).Cells(6).Range.Text = Range("E2")
wordDoc.Tables(1).Columns(1).Cells(6).Shading.BackgroundPatternColorIndex = wdBlue 'fond de cellule en bleu
 
'transfert la donnée de la cellule F2 dans la 6eme cellule de la 2eme colonne
wordDoc.Tables(1).Columns(2).Cells(6).Range.Text = Range("F2")
wordDoc.Tables(1).Columns(2).Cells(6).Shading.BackgroundPatternColorIndex = wdBlue 'fond de cellule en bleu
 
'transfert la donnée de la cellule G2 dans la 8eme cellule de la 1eme colonne
wordDoc.Tables(1).Columns(1).Cells(8).Range.Text = Range("G2")
wordDoc.Tables(1).Columns(1).Cells(8).Shading.BackgroundPatternColorIndex = wdBlue 'fond de cellule en bleu
 
'transfert la donnée de la cellule H2 dans la 8eme cellule de la 2eme colonne
wordDoc.Tables(1).Columns(2).Cells(8).Range.Text = Range("H2")
wordDoc.Tables(1).Columns(2).Cells(8).Shading.BackgroundPatternColorIndex = wdBlue 'fond de cellule en bleu
 
'transfert la donnée de la cellule I2 dans la 10eme cellule de la 1eme colonne
wordDoc.Tables(1).Columns(1).Cells(10).Range.Text = Range("I2")
wordDoc.Tables(1).Columns(1).Cells(10).Shading.BackgroundPatternColorIndex = wdBlue 'fond de cellule en bleu
 
'transfert la donnée de la cellule J2 dans la 10eme cellule de la 2eme colonne
wordDoc.Tables(1).Columns(2).Cells(10).Range.Text = Range("J2")
wordDoc.Tables(1).Columns(2).Cells(10).Shading.BackgroundPatternColorIndex = wdBlue 'fond de cellule en bleu
 
'transfert la donnée de la cellule K2 dans la 12eme cellule de la 1eme colonne
wordDoc.Tables(1).Columns(1).Cells(12).Range.Text = Range("K2")
wordDoc.Tables(1).Columns(1).Cells(12).Shading.BackgroundPatternColorIndex = wdBlue 'fond de cellule en bleu
 
'transfert la donnée de la cellule K2 dans la eme cellule de la 2eme colonne
wordDoc.Tables(1).Columns(2).Cells(12).Range.Text = Range("L2")
wordDoc.Tables(1).Columns(2).Cells(12).Shading.BackgroundPatternColorIndex = wdBlue 'fond de cellule en bleu
 
'save file in ="Y:\2019\RFI\automation\Mastercard Send Cross Border - Compliance Information Request Form_OriginatingID
ActiveDocument.SaveAs Filename:="Y:\2019\doc\automation\Word Form_" & [$F$2], FileFormat:= _
     wdFormatDocument
 
Avec ce code les cellules de mon fichier excel et de mon fichier word sont statique. 
 
J'aimerais automatiser ce code pour que le remplissage du tableau word soit automatique (via une bloucle) et donc dans il me faut aussi une boucle pour faire correspondre les cellules excel (row) au tableau word avec une boucle aussi et donc de ne plus devoir preciser le range de A2 à L2, mais plutôt utiliser une boucle.
 
Avec ce code  je n'ai que la cellule A2 qui est utilisé dans mon tableau word :
 
Sub Tempo_automa_fill_in()
'
' Tempo_automa_fill_in Macro
'
 
 
'Necessite d'activer la reference Microsoft Word xx.x Object Library
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Dim i As Byte, j As Byte
Dim Comp_Starting_celA As Integer
Dim tab_excel(10, 12)
 
Dim Starting_celA As Range  ' tab dans excel "template" starting point of the data  A2
Set Starting_celA = Sheets("tempate").Range("A2") ' Assignation of the starting point
 
 
Set wordApp = CreateObject("word.application")
wordApp.Visible = True 'mettre False pour garder Word masqué
 
Set wordDoc = wordApp.Documents.Open("Y:\2019\RFI\automation\Doc\Mastercard Send Cross Border - Compliance Information Request Form.docx", ReadOnly:=False) 'ouvre le document Word
 
Comp_Starting_celA = 1
 
For i = 1 To 2
For j = 2 To 12
 
 
'Tables(1) correspond au 1eme tableau du document Word
'transfert la donnée de la cellule A1 dans la 2eme cellule de la 1ere colonne
 
wordDoc.Tables(1).Columns(i).Cells(j).Range.Text = Starting_celA   ' malheursement que la cellule A2 
wordDoc.Tables(1).Columns(i).Cells(j).Shading.BackgroundPatternColorIndex = wdBlue 'fond de cellule en bleu
 
 j = j + 1
 
Next j
Next i
 
 
End Sub

malheureusement il n'y a que la cellule A2 qui se rempli dans mon toute les case de mon document Word. Pouvez m'aider à faire la boucle pour la row dans donc mon fichier excel?


Merci d'avance pour votre aide.

Anil

[Philippe Tulliez]

Bonjour,
Voici un exemple d'une procédure qui écrit le contenu des cellules A2:B10 de la feuille active dans les deux premières colonnes du premier tableau d'un document nommé word form.docx se trouvant dans le même répertoire que le classeur où se trouve le code VBA

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
Sub ExcelToWord_Table()
  ' Necessite d'activer la reference Microsoft Word xx.x Object Library
  Dim appWrd As Word.Application
  Dim docWrd As Word.Document
  Dim Folder As String
  Dim r As Long, c As Integer
 
  Folder = ThisWorkbook.Path & "\"
  Set appWrd = CreateObject("word.application")
  Set docWrd = appWrd.Documents.Open(Folder & "word form.docx", ReadOnly:=False)
 
  appWrd.Visible = True 'mettre False pour garder Word masqué
 
  For r = 2 To 10
    For c = 1 To 2
      docWrd.Tables(1).Cell(r, c).Range.Text = Cells(r, c)
    Next c
  Next r
  Set appWrd = Nothing: Set docWrd = Nothing
End Sub

[moiajamoi]

Merci Beaucoup je vais regarder votre réponse.

Anil

[avigeilpro]

Merci a tous

[jonathanl]

Je sais que vous avez déjà répondu a cette question mais je travaille avec un office en anglais ce qui ne facilite pas les choses.
Donc comment faire pour que le type Word.Application soit reconnu par vba dans excel.
je vous remerci d'avance
john

[kikuk]

boujour, la macro suivante donnée par silkyroad plante à la 2eme ligne. je ne sais pas comment activer la reference word xx.x Object Library.
Je voudrais coller un tableau excel sous forme d'image dans word.Quelqu'un peux il m'aider?
merci

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
Sub CollerDansWordFormatBitmap()
'necessite d'activer la reference microsoft Word xx.x Object Library
Dim Wrd As Word.Application
 
Selection.Copy
 
Set Wrd = CreateObject("Word.Application")
On Error Resume Next
Wrd.Documents.Add
Wrd.Visible = True
 
Wrd.Selection.PasteSpecial DataType:=wdPasteBitmap
Application.CutCopyMode = False
 
End Sub

[Heureux-oli]

Pour ajouter la référence à Word, c'est Outils Références dans l'éditeur VBE.