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
i.Delete
Next
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
bb.Delete
Next
Next
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)
Else
' 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
.Collapse
.Text = Left(oRow.Cells(2).Range.Text, Len(oRow.Cells(2).Range.Text) - 2)
.Select
NormalTemplate.AutoTextEntries.Add _
name:=name, Range:=Selection.Range
.Delete
End With
End If
Next
Exit Sub
errormessage:
MsgBox "File C:\autotext.docx is missing"
End Sub
Sub DeleteNormalAutoTextEntries()
'goal: delete all autotext entries from normal.dotm
Dim i As AutoTextEntry
'wissen autotextentries
For Each i In NormalTemplate.AutoTextEntries
i.Delete
Next
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
bb.Delete
Next
Next
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)
Else
' 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
.Collapse
.Text = Left(oRow.Cells(2).Range.Text, Len(oRow.Cells(2).Range.Text) - 2)
.Select
NormalTemplate.AutoTextEntries.Add _
name:=name, Range:=Selection.Range
.Delete
End With
End If
Next
Exit Sub
errormessage:
MsgBox "File C:\autotext.docx is missing"
End Sub
Reacties