| auteur : SilkyRoad |
Nécessite d'activer la référence "Microsoft Word xx.x Object Library" :
vba |
Dim WordApp As Word. Application
Dim WordDoc As Word. Document
Set WordApp = CreateObject (" word.application " )
Set WordDoc = WordApp. Documents . Open (" monDocument.doc " )
WordApp. Visible = True
WordDoc. Tables (1 ). Cell (Row:= 2 , Column:= 3 ). Merge _
mergeTo:= wordDoc. Tables (1 ). Cell (Row:= 3 , Column:= 5 )
|
|
| auteur : SilkyRoad |
Nécessite d'activer la référence "Microsoft Word xx.x Object Library" :
vba |
Dim WordApp As Word. Application
Dim WordDoc As Word. Document
Set WordApp = CreateObject (" word.application " )
WordApp. Visible = False
Set WordDoc = WordApp. Documents . Open (" monDocument.doc " )
WordDoc. Tables (1 ). Rows (3 ). Range . Copy
Range (" A1 " ). PasteSpecial xlPasteValues
WordDoc. Close
WordApp. Quit
|
|
| auteur : SilkyRoad |
Nécessite d'activer la référence "Microsoft Word xx.x Object Library" :
vba |
Dim WordApp As Word. Application
Dim WordDoc As Word. Document
Set WordApp = CreateObject (" word.application " )
WordApp. Visible = True
Set WordDoc = WordApp. Documents . Open (" monDocument.doc " )
WordDoc. Tables (2 ). Columns (1 ). Cells (3 ). Range . Text = Range (" A1 " )
WordDoc. Tables (2 ). Columns (3 ). Cells (2 ). Range . Text = Range (" A2 " )
|
|
| auteur : bidou | La manipulation est un peu particulière.
Si on travaille uniquement avec les collections exposées par le tableau, on n'accède pas à des méthodes comme Copy ou Paste.
Par contre, l'objet Selection expose ces méthodes.
Set objTable = ThisDocument. Tables (1 )
If objTable. Rows . Count > 10 Then
objTable. Rows (1 ). Select
Selection. Copy
objTable. Rows (11 ). Select
Selection. Paste
objTable. Rows (11 ). Select
Selection. SplitTable
End If
|
|
| auteurs : SilkyRoad, Sepia |
Nécessite d'activer la référence "Microsoft Word xx.x Object Library".
vba |
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
|
Vous pouvez aussi vous baser dur l'objet Range :
If (ActiveDocument. Tables (1 ). Cell (1 , 1 ). Range . End - ActiveDocument. Tables (1 ). Cell (1 , 1 ). Range . Start > 1 ) Then
MsgBox " Non Vide "
Else
MsgBox " Vide "
End If
|
|
| auteur : SilkyRoad |
Nécessite d'activer la référence "Microsoft Word xx.x Object Library" :
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 montre comment importer le premier tableau d'un document Word "C:\monFichier.doc" (déjà ouvert), en conservant le format des cellules :
vba |
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
|
|
| auteur : SilkyRoad |
Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
vba |
Dim WordApp As Word. Application
Dim WordDoc As Word. Document
Set WordApp = New Word. Application
WordApp. Visible = True
Set WordDoc = WordApp. Documents . Add
Range (" A1:H10 " ). Copy
WordApp. Selection . Paste
WordDoc. Tables (1 ). AutoFitBehavior wdAutoFitWindow
Application. CutCopyMode = False
|
|
| auteur : SilkyRoad |
Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
Le document Word doit être ouvert :
vba |
Dim WordApp As Word. Application
Dim WordDoc As Word. Document
On Error Resume Next
Set WordApp = GetObject (, " Word.Application " )
Set WordDoc = WordApp. Documents (" monDocument.doc " )
If WordDoc Is Nothing Then
MsgBox " Le document est fermé "
Else
MsgBox WordDoc. MailMerge . DataSource . DataFields (" Nom_Champ " ). Value
End If
|
|
| auteur : SilkyRoad |
Nécessite d'activer la référence "Microsoft Word xx.x Object Library" :
L'exemple ci-dessous insère une image dans la 3e cellule de la 2e colonne du 1er tableau d'un document Word.
vba |
Dim WordApp As Word. Application
Dim WordDoc As Word. Document
Set WordApp = CreateObject (" word.application " )
Set WordDoc = WordApp. Documents . Open (" monDocument.doc " )
WordDoc. Tables (1 ). Columns (2 ). Cells (3 ). Range . InlineShapes . AddPicture _
Filename:= " C:\image1.wmf " , linkToFile:= False , saveWithDocument:= True
With WordDoc. InlineShapes (WordDoc. InlineShapes . Count )
. Height = 150
. Width = 150
End With
WordApp. Visible = True
|
|
| auteur : SilkyRoad |
Nécessite d'activer la référence "Microsoft Word xx.x Object Library" :
L'exemple ci-dessous insère une nouvelle colonne en 3eme position dans le 2e tableau d'un document Word.
La première cellule de cette nouvelle colonne est coloriée en bleu et un texte y est inséré.
vba |
Dim WordApp As Word. Application
Dim WordDoc As Word. Document
Set WordApp = CreateObject (" Word.Application " )
WordApp. Visible = False
Set WordDoc = WordApp. Documents . Open (" monDocument.doc " )
With WordDoc. Tables (2 )
. Columns . Add BeforeColumn:= WordDoc. Tables (2 ). Columns (3 )
. Columns (3 ). Cells (1 ). Shading . BackgroundPatternColorIndex = wdBlue
. Columns (3 ). Cells (1 ). Range . Text = " le forum dvp.com "
. AutoFitBehavior wdAutoFitWindow
End With
WordDoc. Close True
WordApp. Quit
|
|
| auteurs : bidou, Lebeau Olivier | Utiliser une variable objet Table.
Dim objTable As Table
Set objTable = objDoc. Tables . Add (Range:= Selection. Range , NumRows:= 5 , NumColumns:= 3 )
Dim cmpt As Long
For cmpt = 1 To objTable. Rows . Count
objTable. Cell (cmpt, 2 ). Range . Text = " montext " & cmpt
Next cmpt
|
La navigation dans les tableaux est assez similaire à celle d'Excel avec des objets Cells, Columns etc....
Néanmoins, pour accéder au contenu d'une cellule, vous devez passer par l'objet Range de l'objet Cell.
Comment faire une table de multiplication.
Sub TableMult ()
Dim oTbl As Table
Dim iC As Integer
Dim iL As Integer
Set oTbl = ActiveDocument. Tables . Add (Range:= Selection. Range , NumRows:= 10 , numcolumns:= 10 )
For iC = 1 To 10
For iL = 1 To 10
oTbl. Cell (iL, iC). Range . Text = iC * iL
Next iL
Next iC
With oTbl
. Borders . Enable = True
. Borders (wdBorderBottom). LineWidth = wdLineWidth050pt
. Borders (wdBorderLeft). LineWidth = wdLineWidth050pt
. Borders (wdBorderRight). LineWidth = wdLineWidth050pt
. Borders (wdBorderTop). LineWidth = wdLineWidth050pt
End With
End Sub
|
|
| auteur : SilkyRoad |
Nécessite d'activer la référence "Microsoft Word xx.x Object Library" :
vba |
Dim WordApp As Word. Application
Dim WordDoc As Word. Document
Dim i As Byte, j As Byte
Set WordApp = CreateObject (" word.application " )
wWrdApp. Visible = False
Set WordDoc = WordApp. Documents . Open (" monFichier.doc " )
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
|
|
| auteur : Lebeau Olivier |
ActiveDocument. Tables (1 ). Columns . Count
|
Pour obtenir le nombre de colonnes d'un tableau
ActiveDocument. Tables (1 ). Rows . Count
|
Pour obtenir le nombre de lignes
|
| auteur : Sepia |
Le principe est assez simple, on selectionne la première ligne du tableau et on coupe la table en deux, ce qui produit une ligne de texte vide au
dessus du tableau.
Sub AjouterLigne ()
ActiveDocument. Tables (1 ). Rows (1 ). Range . Select
Selection. SplitTable
End Sub
|
|
Consultez les autres F.A.Q's
Les sources présentés sur cette pages sont libre de droits,
et vous pouvez les utiliser à votre convenance. Par contre cette page de présentation de ces sources constitue une oeuvre intellectuelle protégée par les droits d'auteurs.
Copyright ©2008
Developpez LLC. Tout droits réservés Developpez LLC.
Aucune reproduction, même partielle, ne peut être faite de ce site et de
l'ensemble de son contenu : textes, documents et images sans l'autorisation
expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à 3 ans
de prison et jusqu'à 300 000 E de dommages et intérets.
Cette page est déposée à la SACD.
|