donderdag 5 december 2013

Word VBA: Autotext and Built In Building Block Entries

The first script deletes all autotext entire from the normal.dotm

Sub DeleteNormalAutoTextEntries()
    'goal: delete all autotext entries from normal.dotm
    Dim i As AutoTextEntry
    'wissen autotextentries
    For Each i In NormalTemplate.AutoTextEntries
End Sub

The second script deletes all built in building block entries from the template built-in building blocks.dotx

Sub DeleteBuiltinBuildingblockentries()

    'Word 2010 and up
    'goal: delete all elements from built-in building blocks.dotx

    On Error Resume Next 'necessary while deleting from the template causes errors

    Dim objTemplate As Template
    Dim i As Integer 'counter
    Dim bb As Word.BuildingBlock 

    Set objTemplate = Templates(1) 'templates(1) = built-in building blocks.dotx
    For i = 1 To 10 'you need more loupes while it simply doed not work to delete all in one round
        For Each bb In objTemplate.BuildingBlockEntries
    objTemplate.Save 'save template
End Sub

The last script imports given auto text entried from a two column table in a Word document:

Sub ImportAutotextFromWordTable()
    'goal: load autotext entries from Word document table 
    'two columns: the first with the entry lable, the second with the entry text

    On Error GoTo errormessage
    Dim oTable As Table
    Dim oRow As Row
    Dim name As String
    Application.Documents.Open ("C:\autotext.docx") 'this file needs to be in a given map
    For Each oRow In ActiveDocument.Tables(1).Rows
        name = Left(oRow.Cells(1).Range.Text, Len(oRow.Cells(1).Range.Text) - 2)
        If Left(oRow.Cells(2).Range.Text, Len(oRow.Cells(2).Range.Text) - 2) < 256 Then
            NormalTemplate.AutoTextEntries.Add name:=name, Range:=Selection.Range
            NormalTemplate.AutoTextEntries(name).Value = Left(oRow.Cells(2).Range.Text, Len(oRow.Cells(2).Range.Text) - 2)
            ' If the length of the text is greater than 255 characters,
            ' insert it into the active document and add it as a new
            ' AutoText Entry.
            With Selection.Range
                .Text = Left(oRow.Cells(2).Range.Text, Len(oRow.Cells(2).Range.Text) - 2)
                NormalTemplate.AutoTextEntries.Add _
                   name:=name, Range:=Selection.Range
            End With
        End If
    Exit Sub
    MsgBox "File C:\autotext.docx is missing"

End Sub

Geen opmerkingen: