VBA/Excel/Access/Word/Word/ActiveDocument

Activate window by name

   <source lang="vb">

Sub GenerateGlossary()

     Dim strSource As String
     Dim strDestination As String
     Dim strGlossaryName As String
     strSource = ActiveWindow.Caption
     strGlossaryName = "word"
     Documents.Add
     ActiveDocument.SaveAs FileName:=strGlossaryName, FileFormat:=wdFormatDocument
     strDestination = ActiveWindow.Caption
     Windows(strSource).Activate

End Sub

</source>
   
  

Active document paragraph

   <source lang="vb">

Sub loopDemo()

   Dim i As Integer
   For i = 1 To ActiveDocument.Paragraphs.Count
       Application.StatusBar = "formatting" & i & " out of " & ActiveDocument.Paragraphs.Count & "..."
       Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove
   Next i

End Sub

</source>
   
  

Checking to See if a Header or Footer Exists

   <source lang="vb">

Sub footer()

   Dim cSection As Section
   With ActiveDocument
       For Each cSection In .Sections
           cHeader = cSection.Headers(wdHeaderFooterEvenPages)
           If Not cSection.Headers(wdHeaderFooterEvenPages).Exists Then
               cSection.PageSetup.OddAndEvenPagesHeaderFooter = True
               cSection.Headers(wdHeaderFooterEvenPages).Range.Text _
                   = "Section " & cSection.Index & " of " & .FullName
               cSection.Headers(wdHeaderFooterEvenPages).Range. _
                   Style = "Even Footer"
           End If
       Next cSection
   End With

End Sub

</source>
   
  

Closing All Windows but the First for a Document

   <source lang="vb">

Sub close()

   Dim myWin As Window, myDoc As String
   myDoc = ActiveDocument.Name
   For Each myWin In Windows
       If myWin.Document = myDoc Then _
           If myWin.WindowNumber <> 1 Then myWin.Close
   Next myWin

End Sub

</source>
   
  

Creating a Different First-Page Header

   <source lang="vb">

Sub active()

   With ActiveDocument.Sections(10)
       If .Headers(wdHeaderFooterFirstPage).Exists = False Then _
           .PageSetup.DifferentFirstPageHeaderFooter = True
   End With

End Sub

</source>
   
  

Declare the HeaderFooter object variable myHeader and assign to it the primary header in the first section in the active document:

   <source lang="vb">

Sub headerFooter()

   Dim myHeader As HeaderFooter
   Set myHeader = ActiveDocument.Sections(1).Headers _
       (wdHeaderFooterPrimary)

End Sub

</source>
   
  

Defining a Named Range

   <source lang="vb">

Sub act()

   Set FirstPara = ActiveDocument.Paragraphs(1).Range

End Sub

</source>
   
  

Linking to the Header or Footer in the Previous Section

   <source lang="vb">

Sub headerfooter()

   ActiveDocument.Sections(3).Footers(wdHeaderFooterPrimary).LinkToPrevious = False

End Sub

</source>
   
  

Opening a New Window Containing an Open Document

   <source lang="vb">

Sub open()

   Dim myWindow As Window
   Set myWindow = Windows.Add(Window:=ActiveDocument.Windows(1))

End Sub

</source>
   
  

Replace all pairs of paragraph marks in the active document, you could search for ^p^p and replace it with ^p

   <source lang="vb">

Sub replace()

   ActiveDocument.Content.Find.Execute FindText:="^p^p", ReplaceWith:="^p", _
       replace:=wdReplaceAll

End Sub

</source>
   
  

Save active document

   <source lang="vb">

Sub GenerateGlossary()

     Dim strSource As String
     Dim strDestination As String
     Dim strGlossaryName As String
     strSource = ActiveWindow.Caption
     strGlossaryName = "word"
     Documents.Add
     ActiveDocument.SaveAs FileName:=strGlossaryName, FileFormat:=wdFormatDocument
     strDestination = ActiveWindow.Caption
     Windows(strSource).Activate

 End Sub
</source>
   
  

Save document as

   <source lang="vb">

Sub saveAs()

   ActiveDocument.saveAs "c:\d.doc"

End Sub

</source>
   
  

Turning Off Track Changes

   <source lang="vb">

Sub trac()

   Dim blnTrackChangesOn As Boolean
   blnTrackChangesOn = ActiveDocument.TrackRevisions
   ActiveDocument.TrackRevisions = False
   ActiveDocument.TrackRevisions = blnTrackChangesOn

End Sub

</source>
   
  

Uppercase the first three words at the start of a document

   <source lang="vb">

Sub upper()

   Dim InitialCaps As Range
    Set InitialCaps = ActiveDocument.Range(Start:=ActiveDocument.Words(1).Start, _
       End:=ActiveDocument.Words(3).End)
   InitialCaps.Case = wdUpperCase

End Sub

</source>
   
  

Using the Duplicate Property to Store or Copy Formatting

   <source lang="vb">

Sub dup()

   Dim Range1 As Range, Range2 As Range
   Set Range1 = Selection.Range.Duplicate
   Set Range2 = ActiveDocument.Bookmarks(1).Range
   Range2.Paragraphs(1).Range = Range2

End Sub

</source>