Macro: how to transfer a list from doc to autotext entries

[danspierre]

I'm working in a shorthand and text production office. As a great number of
similar expressions repeatedly occur in the speeches to be recorded, an
optimized list of autotext entries would be useful. For example: autotext
entries (names and values) are listed (and edited) in a doc file Word2003 and
then running an appropriate macro results in their storage as autotexts. Is
it possible to do this?
Thanks
bl

 

[Graham Mayor]

The following macro will read the names and texts from a two column table
and write them to the normal template. The table is stored in the example in
the document defined at
sFname = "D:\My Documents\Test\AutotextTable.doc"
which you can change as required.

The first column contains the text name and the second the text.

Autotexts are filed according to the style applied, so format texts in the
second column with the individual styles under which you wish each entry to
be saved. If you want the formatting of that style to be retained, terminate
the text with a paragraph mark (press enter).

If the texts change, re-running the macro will make the changes to the
template, overwriting the original entries.

Sub AddAutoTextFromTable()
Dim aTextDoc As Document
Dim cTable As Table
Dim rName As Range, rText As Range
Dim i As Long
Dim sFname As String

sFname = "D:\My Documents\Test\AutotextTable.doc"
Set aTextDoc = Documents.Open(sFname)
Set cTable = aTextDoc.Tables(1)

For i = 1 To cTable.Rows.Count
Set rName = cTable.Cell(i, 1).Range
rName.End = rName.End - 1
Set rText = cTable.Cell(i, 2).Range
rText.End = rText.End - 1

NormalTemplate.AutoTextEntries.Add name:=rName, _
Range:=rText
Next i
aTextDoc.Close wdDoNotSaveChanges
End Sub

The following macro will remove the autotext entries from the normal
template associated with the same table.

Sub RemoveAutoTextFromTable()
Dim aTextDoc As Document
Dim cTable As Table
Dim rName As Range, rText As Range
Dim i As Long
Dim sFname As String

sFname = "D:\My Documents\Test\AutotextTable.doc"
Set aTextDoc = Documents.Open(sFname)
Set cTable = aTextDoc.Tables(1)

On Error Resume Next
For i = 1 To cTable.Rows.Count
Set rName = cTable.Cell(i, 1).Range
rName.End = rName.End - 1
NormalTemplate.AutoTextEntries(rName).Delete
Next i
aTextDoc.Close wdDoNotSaveChanges
End Sub

http://www.gmayor.com/installing_macro.htm

You might also consider autocorrect - see
http://word.mvps.org/faqs/customization/ExportAutocorrect.htm for similar
routines for use with Autocorrect.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[danspierre]

Hello, meantime I arrived to write a code which works (converted from Word6.0
to Word2003):
Public Sub MAIN()
Dim first$
Dim p$
Dim r$
Dim last$
Dim g$
Dim h$
WordBasic.StartOfDocument
first$ = WordBasic.[InputBox$]("First Entry")
While p$ <> first$
WordBasic.SelectCurSentence
p$ = WordBasic.[Selection$]()
WordBasic.NextCell
WordBasic.SelectCurSentence
r$ = WordBasic.[Selection$]()
WordBasic.NextCell
Wend
WordBasic.PrevCell
WordBasic.PrevCell
last$ = WordBasic.[InputBox$]("Last Entry")
While Not g$ = last$
WordBasic.SelectCurWord
g$ = WordBasic.[Selection$]()
WordBasic.NextCell
WordBasic.SelectCurSentence
h$ = WordBasic.[Selection$]()
WordBasic.SetAutoText g$, h$
WordBasic.NextCell
Wend
End Sub

I am a very beginner in WB. A composed a similar one for AutoCorrection.
Your code should be very similar but reflects a professional way of handling
the subject.
Thanks
L. Benko
(e-mail address removed)