Page Accueil FAQ MPFE Liens Format de nombres Téléchargement Applications Combinaisons


* * *
  SOMMAIRE
  La FAQ
  VBAXL
  BASIC
  ASTUCES
Exemples
  Boucles
  Cellules
  Cellules 2
  Divers
  Erreurs
  Fichiers
  Feuilles
  Impression
  Médias
  Messages
  Outils
  Spéciales
  Tests
  Le Web
  Userform
  XL et Word
  XL Clipboard
  XL 2007
  XL et XML
 
  Macro :o)
  Réactions
  Livre d'Or

 

titre


Excel et Word

Si vous ne l'avez pas déjà fait :
Dans l'éditeur VB, ajoutez une référence à "Microsoft Word 8.0 Object Library"
Menu Outils --> Références

Ouvre Word et le fichier Test.doc

Sub ouvreWord()

spécifier le chemin au cas où...
Si vous attribuez la valeur 1 au 2 ème argument
l'application s'ouvre à sa taille normale et devient l'application active.

MyAppID = Shell _
("C:\Program Files\Microsoft Office\Office\Winword.EXE D:\ajeter\test.doc", 1)
AppActivate MyAppID
End Sub

Sub ouvreWord2()

'comme celà...

MyAppID = Shell _
("C:\Office\Office\Winword.EXE D:\ajeter\test.doc", 1)
AppActivate MyAppID
End Sub

Sub ouvrwd97()

'où bien comme celà...avec Office 97

MyAppID = Shell _
("C:\Office97\Office\Winword.EXE D:\ajeter\test.doc", 1)
AppActivate MyAppID
End Sub

Ouvre Word et le fichier Test.doc même avec un espace dans le chemin

Sub ouvrwordAvecEspace()

'Lorsqu'il y a un espace dans le nom du repertoire: ajout de " "

MyAppID = Shell("Winword.EXE ""C:\Mes documents\test.doc""", 1)
End Sub

Procédure pour écrire dans Word

Sub EcriDansWord()
Dim WordObj As Object
On Error Resume Next
Set WordObj = CreateObject("Word.Application.8")

'Pour afficher Word

WordObj.Visible = True

'Ajoute un document

WordObj.Documents.Add

With WordObj.Selection
.TypeParagraph
.TypeText Text:="Procédure pour écrire dans Word "
.TypeParagraph
.TypeText Text:="Daniel :o)"
.TypeParagraph
End With

'pour imprimer le document

WordObj.PrintOut
Set WordObj = Nothing
End Sub

Procédure pour exécuter une macro de Word (LancerParXL)

'Macro qui, par exemple, ouvre un document et l'imprime

Sub EcriDansWord()
Dim WordObj As Object
Set WordObj = CreateObject("Word.Application.8")
WordObj.Visible = True
WordObj.Documents.Add
WordObj.Run "LancerParXL"
End Sub

2 procédures maintenant:
La première écrit les commentaires de cellules dans Word
La deuxième écrit les formules. (Auteur=?)

Public Sub PrintCellComments()

Dim Cmt As String
Dim C As Range
Dim I As Integer
Dim WordObj As Object
Dim ws As Worksheet
Dim PrintValue As Boolean
Dim res As Integer
On Error Resume Next
Err.Number = 0

res = MsgBox("Voulez-vous éditer les commentaires?", _
vbYesNoCancel + vbQuestion, "Edition des commentaires de cellules")
Select Case res
Case vbCancel
Exit Sub
Case vbYes
PrintValue = True
Case Else
PrintValue = False
End Select
Set WordObj = GetObject(, "Word.Application.8")
If Err.Number = 429 Then
Set WordObj = CreateObject("Word.Application.8")
Err.Number = 0
End If

WordObj.Visible = True
WordObj.Documents.Add
With WordObj.Selection
.TypeText Text:="Commentaires dans le classeur: " + ActiveWorkbook.Name
.TypeParagraph
.TypeText Text:="Date: " + Format(Now(), "dd-mmm-yy hh:mm")
.TypeParagraph
.TypeParagraph
End With

For Each ws In Worksheets
For I = 1 To ws.Comments.Count
Set C = ws.Comments(I).Parent
Cmt = ws.Comments(I).Text
With WordObj.Selection
.TypeText Text:="Commentaire dans la cellule: " + _
C.Address(False, False, xlA1) + " feuille: " + ws.Name
If PrintValue = True Then
.TypeText Text:=" Cell Value: " + Format(C.Value)
End If
.TypeParagraph
.TypeText Text:=Cmt
.TypeParagraph
.TypeParagraph
End With
Next I
Next ws

Set WordObj = Nothing
MsgBox "OK...commentaires dans Word", vbInformation, "Edition des Commentaires"
End Sub



Public Sub PrintFormulasToWord()

Dim Cnt As String
Dim C As Range
Dim WordObj As Object
Dim HasArr As Boolean

On Error Resume Next
Err.Number = 0

Set WordObj = GetObject(, "Word.Application.8")
If Err.Number = 429 Then
Set WordObj = CreateObject("Word.Application.8")
Err.Number = 0
End If

WordObj.Visible = True
WordObj.Documents.Add

With WordObj.Selection
.Font.Name = "Arial"
.TypeText "Formules dans la feuille: " + ActiveSheet.Name
.TypeParagraph
.TypeText "Cells: " + Selection.Cells(1, 1).Address(False, False, xlA1) _
& " to " & Selection.Cells(Selection.Rows.Count, Selection.Columns.Count) _
.Address(False, False, xlA1)
.TypeParagraph
.TypeParagraph
End With

For Each C In Selection
HasArr = C.HasArray
Cnt = C.Formula
If HasArr Then
Cnt = "{" + Cnt + "}"
End If
If Cnt <> "" Then
With WordObj.Selection
.Font.Bold = True
.TypeText C.Address(False, False, xlA1) & ": "
.Font.Bold = False
.TypeText Cnt
.TypeParagraph
.TypeParagraph
End With
End If
Next C
MsgBox "Edition des formules dans Word. ", , "Formules dans Word"
End Sub

Comment envoyer la valeur d'une cellule vers un signet?

'Supposant un document lettre.doc contenant les signets: "Monsignet" et "Monsignet2"

Sub EcritVersSignet()
Dim LaLettre As String
Dim LeMontant
Dim LeTexte2
Dim ObjWord As Word.Application
Dim LeDocWord As Word.Document

On Error Resume Next

LaLettre = ThisWorkbook.Path & "\lettre.doc"
Set ObjWord = CreateObject("Word.Application")
ObjWord.Visible = True
Set LeDocWord = ObjWord.Documents.Open(LaLettre)
LeMontant = [A1]
LeTexte2 = [A2]
With LeDocWord
'Le nom du signet dans le document word est ici "Monsignet"
.Bookmarks("Monsignet").Range.Text = LeMontant
'Le nom du signet dans le document word est ici "Monsignet2"
.Bookmarks("Monsignet2").Range.Text = LeTexte2
End With

'Pour enregistrer le document et quitter Word
'LeDocWord.Save
'ObjWord.Quit

Set ObjWord = Nothing
End Sub

 

[top]

 

     
 ©Conception et Graphisme. Daniel Josserand . Novembre 2000