VBA/Excel/Access/Word/Word/ActiveDocument — различия между версиями

Материал из VB Эксперт
Перейти к: навигация, поиск
м (1 версия)
 
м (1 версия)
 
(нет различий)

Текущая версия на 12:48, 26 мая 2010

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