Solved: create document to list all AutoText associated witha style
I am trying to use vba to create a new document that lists all of the autotext entries formated:
Autotext entry name
Autotext entry
___________________________________________________________
I have found the code below which lists all autocorrect entries but cannot seem to figure out how to do something similar with autotext. I would like the user to select a style and click a toolbar button to produce the associated autotext list.
Code for autocorrect:
[vba]Dim ACE As AutoCorrectEntry
Documents.Add
For Each ACE In Application.AutoCorrect.Entries
Selection.TypeText ACE.Name & vbTab & ACE.Value & " " & vbCr
Next
'Format document for three columns.
With ActiveDocument.PageSetup.TextColumns
.SetCount NumColumns:=3
.EvenlySpaced = True
.LineBetween = True
.Width = InchesToPoints(1.67)
.Spacing = InchesToPoints(0.5)
End With
ActiveDocument.Paragraphs.TabStops(InchesToPoints(0.88)).Position = _
InchesToPoints(0.88)[/vba] [UVBA].[/UVBA]
~Oorang
Any help would be appreciated
Thanks
Dan
Heres what I put together
Thanks fumei,
Your help got me through.... Here is what I ended up with. A form with a list box, a combobox and a few buttons.
When the form opens the combobox is populated with styles. When a style is selected, the listbox loads with autotext entries that use that style.
The button options are Print the items displayed in the listbox. Backup, which actually just builds a document that the user can save, and your insert button which inserts the autotext entry selected.
This does about everything I had wanted, due to your kick start.
Thanks So Much
DC
[vba]Private Sub cbBackup_Click()
Dim aDialog As Dialog
Documents.Add
Set myRange = Selection.Range
myRange.WholeStory
myRange.Font.Name = "Arial"
myRange.Font.Size = 11
With ActiveDocument.PageSetup
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(1)
.LeftMargin = InchesToPoints(1.25)
.RightMargin = InchesToPoints(1.25)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.GutterPos = wdGutterPosLeft
End With
Dim atEntry As AutoTextEntry
For Each atEntry In Application.NormalTemplate.AutoTextEntries
If atEntry.StyleName = ComboBox1.Value Then
Selection.Font.Size = 14
Selection.TypeText Text:=atEntry.Name
Selection.Font.Size = 10
Selection.TypeParagraph
Selection.TypeText atEntry.Value
Selection.TypeText "" & vbCrLf & ""
Selection.TypeParagraph
End If
Next
ActiveDocument.Activate
Set aDialog = Application.Dialogs(wdDialogFileSaveAs)
With aDialog
.Name = ComboBox1.Value & " Backup"
.Show
End With
Unload spt_AutotextGroup
End Sub
Private Sub cbClose_Click()
Unload Me
End Sub
Private Sub cbPrint_Click()
Dim aDialog As Dialog
Documents.Add
Set myRange = Selection.Range
myRange.WholeStory
myRange.Font.Name = "Arial"
myRange.Font.Size = 11
With ActiveDocument.PageSetup
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(1)
.LeftMargin = InchesToPoints(1.25)
.RightMargin = InchesToPoints(1.25)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.GutterPos = wdGutterPosLeft
End With
Dim atEntry As AutoTextEntry
For Each atEntry In Application.NormalTemplate.AutoTextEntries
If atEntry.StyleName = ComboBox1.Value Then
Selection.Font.Size = 14
Selection.TypeText Text:=atEntry.Name
Selection.Font.Size = 10
Selection.TypeParagraph
Selection.TypeText atEntry.Value
Selection.TypeText "" & vbCrLf & ""
Selection.TypeParagraph
End If
Next
ActiveDocument.PrintOut
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub
Private Sub ComboBox1_Change()
ListBox1.Clear
Dim atEntry As AutoTextEntry
For Each atEntry In Application.NormalTemplate.AutoTextEntries
If atEntry.StyleName = ComboBox1.Value Then
ListBox1.AddItem atEntry.Name
End If
Next
End Sub
Private Sub Userform_Initialize()
Dim atStyle As Word.Style
For Each atStyle In ActiveDocument.Styles
If atStyle.InUse = True Then
With ComboBox1
.AddItem (atStyle.NameLocal)
End With
End If
Next
End Sub
Private Sub cmdInsert_Click()
Dim strAT_Name As String
strAT_Name = ListBox1.Value
If Selection.Style = ComboBox1.Value Then
Selection.Collapse Direction:=wdCollapseEnd
ActiveDocument.AttachedTemplate.AutoTextEntries(strAT_Name).Insert _
Where:=Selection.Range
Selection.TypeText " - " & ListBox1.Value
Else
MsgBox "The style at the selection does not " & _
"the style of the selected AutoText."
End If
Unload Me
End Sub
[/vba]