Dialogs(wdDialogFileOpen).Show

Selection.Font.Underline = wdUnderlineWavyHeavy

Public Sub normalchemin()
MsgBox Application.NormalTemplate.Path

End Sub

Application.ScreenUpdating = False ' fige l'affichage

Application.ScreenUpdating = True  ' pour dégeler l'affichage

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 & "\" & 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

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 Test()  
	IsolerPage 4 
End Sub     

Public Sub IsolerPage(NumPage As Integer)  
Dim NbLigne As Long  
Dim NombrePage As Integer  
NombrePage = _ 
	ActiveDocument.BuiltInDocumentProperties("Number of Pages")  
	If NombrePage < NumPage Then Exit Sub  
	ActiveDocument.Range.Select  
	Selection.GoTo What:=wdGoToPage, _
 		Which:=wdGoToAbsolute, Count:=NumPage + 1  
	Selection.Move Unit:=wdCharacter, Count:=-1  
	
	If NombrePage = NumPage Then Selection.Move Unit:=wdCharacter, _ 
		Count:=ActiveDocument.Range.Characters.Count  

	NbLigne = Selection.Information(wdFirstCharacterLineNumber)  

	If NombrePage = NumPage Then NbLigne = NbLigne - 1  
	
	Selection.Move Unit:=wdCharacter, Count:=1  

	With Selection 
		.HomeKey Unit:=wdLine, Extend:=wdMove 
		.ExtendMode = True  
		.MoveUp Unit:=wdLine, Count:=NbLigne 
		.ExtendMode = False  
	End With  
	Selection.Copy  
	Documents.Add  
	ActiveDocument.Range.Paste   
	If NumPage < NombrePage Then  
		Selection.Move Unit:=wdCharacter, _ 
			Count:=ActiveDocument.Range.Characters.Count  
		Selection.Delete Unit:=wdCharacter, Count:=1  
	End If 
End Sub

Dim WordApp As Word.Application

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

Dim objDoc As Document, objRange As Range

Set objDoc = Application.Documents.Open("c:\jmarc\tuto.doc")
With objDoc.Content.Find
    .ClearFormatting
    Do While .Execute(FindText:="GNU", Forward:=True, Format:=True) = True
        With .Parent
            .StartOf Unit:=wdWord, Extend:=wdExtend
            .Borders.Enable = True
        End With
    Loop
End With

With ActiveDocument.PageSetup
        .Orientation = wdOrientLandscape
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = True
        .DifferentFirstPageHeaderFooter = True
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = True
End With

objDoc.Password= "passe"

ActiveDocument.Protect Password:="monpasse", NoReset:=False, Type:=wdAllowOnlyComments

ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = "En-tête"
With ActiveDocument.StoryRanges(wdPrimaryHeaderStory)
    .Bold = True
    .ParagraphFormat.Alignment = wdAlignParagraphCenter
End With

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

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

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")    'adapter le chemin
    With WordDoc.Sections(1)
        .Headers(wdHeaderFooterPrimary).Range.Text = "Le titre"
        .Headers(wdHeaderFooterPrimary).Range.Paragraphs.Alignment = wdAlignParagraphCenter
        .Footers(wdHeaderFooterPrimary).PageNumbers.Add
    End With

Dim WordApp As Word.Application
Dim WordDoc As Word.Document

    Set WordApp = CreateObject("Word.Application")
    Set WordDoc = WordApp.Documents.Add
    WordApp.Visible = True

    With WordDoc.PageSetup
        .LeftMargin = CentimetersToPoints(1)
        .RightMargin = CentimetersToPoints(1)
        .TopMargin = CentimetersToPoints(1.5)
        .BottomMargin = CentimetersToPoints(2)
    End With

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")

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

Set objDoc = Application.Documents.Open("c:\jmarc\tuto.doc")
objDoc.Content.Find.Execute FindText:="GNU", ReplaceWith:="GPL", Replace:=wdReplaceAll

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

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

Set objDoc = GetObject("d:\user\tuto.doc")

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

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

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

End Sub

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

Sub printPDF()

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

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

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

Application.ChangeFileOpenDirectory "C:\temp"

Application.Commandbars("Menu Bar").Controls(2).Enabled = false

ActiveDocument.Bookmarks(1).range.Select
With Selection
    .text = "Mon Texte"
    .Font.Bold = True
End With

Documents("MonDocument.docm").MaRoutine

VarType(MaVariable)