VBA/Excel/Access/Word/Word/ActiveDocument

Activate window by name

 
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

Active document paragraph

 
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

Checking to See if a Header or Footer Exists

 
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

Closing All Windows but the First for a Document

 
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

Creating a Different First-Page Header

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

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

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

Defining a Named Range

 
Sub act()
    Set FirstPara = ActiveDocument.Paragraphs(1).Range
End Sub

Linking to the Header or Footer in the Previous Section

 
Sub headerfooter()
    ActiveDocument.Sections(3).Footers(wdHeaderFooterPrimary).LinkToPrevious = False
End Sub

Opening a New Window Containing an Open Document

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

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

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

Save active document

 
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

Save document as

 
Sub saveAs()
    ActiveDocument.saveAs "c:\d.doc"
End Sub

Turning Off Track Changes

 
Sub trac()
    Dim blnTrackChangesOn As Boolean
    blnTrackChangesOn = ActiveDocument.TrackRevisions
    ActiveDocument.TrackRevisions = False
    ActiveDocument.TrackRevisions = blnTrackChangesOn
End Sub

Uppercase the first three words at the start of a document

 
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

Using the Duplicate Property to Store or Copy Formatting

 
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