Dim WordApp As Word.Application

    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True
    
    WordApp.Documents.Open ("C:\monDocument.dot")
    WordApp.Run "laMacro"

objDoc.Range(0, 0).Select
Selection.MoveEnd wdStory

Selection.HomeKey Unit:=wdStory

Selection.EndKey Unit:=wdStory

Selection.EndKey Unit:=wdLine, Extend:=wdExtend

objDoc.Paragraphs(3).Range.Select

'Notez que c'est donc différent des lignes word
Dim objDoc As Document, Phrase As Range

Set objDoc = Application.Documents.Open("D:\tuto.doc")
MsgBox objDoc.Sentences.Count & vbCrLf & objDoc.BuiltInDocumentProperties(wdPropertyLines)
For Each Phrase In objDoc.Sentences
    Phrase.Select
    MsgBox "suite"
Next

Sub Document_Open()
ActiveDocument.Bookmarks("ICI").Select
ActiveDocument.Bookmarks("ICI").Delete
End Sub

Sub Document_Close()
With Selection
    .Bookmarks.Add "ICI"
End With

End Sub

Documents("MonDocument.docm").MaRoutine

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Const HWND_DESKTOP As Long = 0
Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90

Function TwipsPerPixelX() As Single
Dim lngDC As Long
    lngDC = GetDC(HWND_DESKTOP)
    TwipsPerPixelX = 1440 & / GetDeviceCaps(lngDC, LOGPIXELSX)
    ReleaseDC HWND_DESKTOP, lngDC
End Function

Function TwipsPerPixelY() As Single
Dim lngDC As Long
    lngDC = GetDC(HWND_DESKTOP)
    TwipsPerPixelY = 1440 & / GetDeviceCaps(lngDC, LOGPIXELSY)
    ReleaseDC HWND_DESKTOP, lngDC
End Function

'-- Déclaration des fonctions API
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

Private Sub Commande0_Click()
    OpenClipboard 0 
    EmptyClipboard
    CloseClipboard
End Sub

ActiveDocument.Range(ActiveDocument..Bookmarks("sig1").Range.Start, _
ActiveDocument..Bookmarks("sig2").Range.End).Select 

Selection.TypeText Text:="Monsieur "
Set objRange = Selection.Words.First.Previous(wdWord)
objRange.Bookmarks.Add "genre"
With ActiveDocument.Bookmarks
    .Add Range:=Selection.Range, Name:="Nom"
    .DefaultSorting = wdSortByName
    .ShowHidden = True
End With

Sub printPDF()

Dim oldprint
oldprint = Application.ActivePrinter
Application.ActivePrinter = "PDFCreator"
ActiveDocument.PrintOut
Application.ActivePrinter = oldprint
End Sub

VarType(MaVariable)

Sub ConnexionDBAccess()
'Déclaration des variables
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sql As String
'Affectation de la sentence SQL
sql = "SELECT * From T_Adresses"
'Affectation des Objets d'access aux données
Set db = DBEngine.OpenDatabase( _
   "C:\Documents and Settings\Olivier\Mes documents\Mes sources de données\DB_Publipostage.mdb")
Set rs = db.OpenRecordset(sql)
'Boucle pour la récupération des données
While Not rs.EOF
Debug.Print rs.Fields(2)
rs.MoveNext
Wend
'Libération des objets
rs.Close
db.Close

Set rs = Nothing
Set db = Nothing

End Sub

Sub OuvrirFichierXL()
Dim xlApp As Object
Dim xlWb As Object

Set xlApp = CreateObject("Excel.Apllication")
Set xlWb = xlApp.WoorkBooks.Add

xlApp.Visible = True
End Sub

Dim objDoc As Document

Set objDoc = Application.Documents.Open("c:\jmarc\tuto.doc")
objDoc.Paragraphs(3).Range.Select
objDoc.Paragraphs(3).Range.EndOf wdWord, wdMove

Dim objDoc As Document, objRange As Range

Set objDoc = Application.Documents.Open("c:\jmarc\tuto.doc")
objDoc.Paragraphs(3).Range.Words(objDoc.Paragraphs(3).Range.Words.Count - 2).Select
Set objRange = objDoc.Paragraphs(3).Range
objRange.EndOf wdWord, wdMove
objRange.Select

Dim WordApp As Word.Application
Dim WordDoc As Word.document

    Set WordApp = New Word.Application
    WordApp.Visible = True
    Set WordDoc = WordApp.Documents.Open("monDocument.doc")

    WordDoc.Bookmarks("SignetDate").Range.Text = Format(Now, "dd/mm/yyyy")

Application.Options.DefaultFilePath(wdDocumentsPath) = "c:\temp"

Application.ChangeFileOpenDirectory "C:\temp"

Type MyVar
    IntA As Integer
    IntB As Integer
End Type

Sub MaProc()
Dim MyData As MyVar

With MyData
    .IntA = 10
    .IntB = 20
End With
MyData = monCalcul(MyData)
Debug.Print MyData.IntA, MyData.IntB

End Sub

Public Function monCalcul(MyDt As MyVar) As MyVar
monCalcul.IntA = MyDt.IntA * 2
monCalcul.IntB = MyDt.IntB / 4

End Function

Sub Fautes()
Dim mesFotes
Dim toutesmesfotes

For Each mesFotes In ActiveDocument.SpellingErrors
mesFotes.Select
toutesmesfotes = toutesmesfotes & vbCrLf & Selection
Next mesFotes
Application.Documents.Add
ActiveDocument.Content.InsertAfter toutesmesfotes
ActiveDocument.SaveAs FileName:="c:\temp\mesftes.txt", FileFormat:=wdFormatText
ActiveDocument.Close


End Sub

   CustomizationContext = NormalTemplate
    KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyE, _
	  wdKeyControl, wdKeyShift), KeyCategory:=wdKeyCategoryCommand, Command:="Superscript"

Dim objDoc As Word.Document, msg As String

Set objDoc = Application.Documents.Open("d:\tuto.doc")
MsgBox "Le documents contient " & objDoc.ComputeStatistics(wdStatisticPages) & _
" pages et " & objDoc.ComputeStatistics(wdStatisticWords) & " mots"

Sub remplacement_Macro_WordDot() 
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" 
Fichier = Dir(Direction & "\*.dot") 
Do While Fichier <> ""   
Set Doc = Documents.Open(Direction &amp; "\" &amp; 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

Dialogs(wdDialogFileOpen).Show

Set oTbl = ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=11, Numcolumns:=11)

Set oTbl = ActiveDocument.Tables.Add(Selection.Range, 11, 11)

Set oDoc = Documents.Add(Visible:=yes)

Set oDoc = Documents.Add(, , , yes)