How can I sort autext entries into alpha order before inserting themin a listbox on a userform

P

PeterEvans

I have a program that displays autotext entry names in a userform in a
listbox. The user can then scroll through the list, or use arrows or
type the autotext name to select the entry they want. And then click a
button to insert this as a Comment or insert it inline in the
document.

This all works well and you can see a screen image image at:
http://baker-evans.com/emarking-assistant

<b>The problem is that when a new autotext entry is defined and the
comment picker is loaded the diaplayed entries are not in alphabetical
order. How can I sort them into alph order before loading them in to
the comment picker?</b>

Thanks in advance for any assistance,
PeterEvans

The code that loads the autotext enteries into the comment picker is
shown below:

Public Sub showCommentPicker()
Dim i As Long
Dim UFrm As AutoTextPicker

Set UFrm = New AutoTextPicker
With UFrm
.Show
End With

'load the autotext comments
Dim myAutoTextEntries As AutoTextEntries

For i = 1 To NormalTemplate.AutoTextEntries.Count
With NormalTemplate.AutoTextEntries(i)

'If Mid(.name, 1, 1) = "." Then
'only show it if there is the name starts with a .
UFrm.cmbAutotext.AddItem .name
UFrm.cmbAutotext.List(UFrm.cmbAutotext.ListCount - 1,
1) = .Value
'End If
End With
Next i
UFrm.refnum = "1"
End Sub

The code for inserting the autotext as a comment or as a text is shown
below


Private Sub cmdInsertComment_Click()

Dim oRng As Word.Range
Dim oCom As Comment
Dim thetitle As String
Dim themessage As String


Set oCom = ActiveDocument.Comments.Add(Range:=Selection.Range,
text:="")
NormalTemplate.AutoTextEntries(autoTextItemNum).Insert oCom.Range,
True
End Sub


Private Sub cmdInsertText_Click()

Dim newtext As String

NormalTemplate.AutoTextEntries(autoTextItemNum).Insert
Where:=Selection.Range, RichText:=True
End Sub

thanks to the people who contributed ideas in
http://groups.google.com/group/micr...en&lnk=gst&q=autotext+window#b7dea7f47ca73da2
 
G

Greg Maxey

You code example didn't work for me. You could but the entries into an
array, sort the array, then load the combobox using the array. Something
like this:

Public Sub showCommentPicker()
Dim i As Long
Dim UFrm As AutoTextPicker
Dim arrAutoText() As String
Set UFrm = New AutoTextPicker
ReDim arrAutoText(NormalTemplate.AutoTextEntries.Count - 1)
For i = 0 To NormalTemplate.AutoTextEntries.Count - 1
arrAutoText(i) = NormalTemplate.AutoTextEntries(i + 1).Name
Next i
'See: http://word.mvps.org/faqs/macrosvba/SortArray.htm
WordBasic.SortArray arrAutoText()
'Or
BubbleSort arrAutoText
UFrm.cmbAutoText.List = arrAutoText()
With UFrm
.Show vbModeless
End With
End Sub


Sub BubbleSort(ToSort As Variant, Optional SortAscending As Boolean = True)
Dim AnyChanges As Boolean
Dim x As Long
Dim SwapFH As Variant
Do
AnyChanges = False
For x = LBound(ToSort) To UBound(ToSort) - 1
If (ToSort(x) > ToSort(x + 1) And SortAscending) _
Or (ToSort(x) < ToSort(x + 1) And Not SortAscending) Then
SwapFH = ToSort(x)
ToSort(x) = ToSort(x + 1)
ToSort(x + 1) = SwapFH
AnyChanges = True
End If
Next x
Loop Until Not AnyChanges
End Sub

Private Sub cmdInsertComment_Click()
Dim oCom As Comment
Set oCom = ActiveDocument.Comments.Add(Range:=Selection.Range, Text:="")
NormalTemplate.AutoTextEntries(cmbAutoText.ListIndex + 1).Insert oCom.Range,
True
End Sub

Private Sub cmdInsertText_Click()
NormalTemplate.AutoTextEntries(cmbAutoText.ListIndex + 1).Insert
Where:=Selection.Range, RichText:=True
End Sub
 
P

PeterEvans

Thanks Greg,

I can now sort the autotext entries and filter out ones that are not
relevant and then enter them into the two fields
* cmbAutotext -- to show the name of the autotext entry and
* txtAutotextValue -- to show the text of the autotext entry

(I ended up using two arrays to do the sort of the names and the
values -- not ellegant ... but it is done (see below))

but I can't insert the autotextenties into the document as either
comments or in text becuase they are no longer in the same order as
the original autotext entires

I was originally using:
NormalTemplate.AutoTextEntries(autoTextItemNum).Insert oCom.Range,
True

How can I insert the correct autotext entry into my document

-------------

For i = 0 To NormalTemplate.AutoTextEntries.Count - 1
arrAutoText(i) = NormalTemplate.AutoTextEntries(i + 1).Name
arrAutoTextValue(i) = NormalTemplate.AutoTextEntries(i +
1).Value
Next i

Dim AnyChanges As Boolean
Dim x As Long
Dim SwapFH As Variant
Dim SwapFH1 As Variant
Do
AnyChanges = False
For x = LBound(arrAutoText) To UBound(arrAutoText) - 1
If (arrAutoText(x) > arrAutoText(x + 1)) Then
SwapFH = arrAutoText(x)
arrAutoText(x) = arrAutoText(x + 1)
arrAutoText(x + 1) = SwapFH

SwapFH1 = arrAutoTextValue(x)
arrAutoTextValue(x) = arrAutoTextValue(x + 1)
arrAutoTextValue(x + 1) = SwapFH1

AnyChanges = True
End If
Next x
Loop Until Not AnyChanges
---
 
G

Greg Maxey

Peter,

I just don't have time to try to create your userform and work out the code.
If you want to send my the file I will try to look at it this weekend. You
can contact me via the feedback link on my website.



--
Greg Maxey - Word MVP

My web site http://gregmaxey.mvps.org



Thanks Greg,

I can now sort the autotext entries and filter out ones that are not
relevant and then enter them into the two fields
* cmbAutotext -- to show the name of the autotext entry and
* txtAutotextValue -- to show the text of the autotext entry

(I ended up using two arrays to do the sort of the names and the
values -- not ellegant ... but it is done (see below))

but I can't insert the autotextenties into the document as either
comments or in text becuase they are no longer in the same order as
the original autotext entires

I was originally using:
NormalTemplate.AutoTextEntries(autoTextItemNum).Insert oCom.Range,
True

How can I insert the correct autotext entry into my document

-------------

For i = 0 To NormalTemplate.AutoTextEntries.Count - 1
arrAutoText(i) = NormalTemplate.AutoTextEntries(i + 1).Name
arrAutoTextValue(i) = NormalTemplate.AutoTextEntries(i +
1).Value
Next i

Dim AnyChanges As Boolean
Dim x As Long
Dim SwapFH As Variant
Dim SwapFH1 As Variant
Do
AnyChanges = False
For x = LBound(arrAutoText) To UBound(arrAutoText) - 1
If (arrAutoText(x) > arrAutoText(x + 1)) Then
SwapFH = arrAutoText(x)
arrAutoText(x) = arrAutoText(x + 1)
arrAutoText(x + 1) = SwapFH

SwapFH1 = arrAutoTextValue(x)
arrAutoTextValue(x) = arrAutoTextValue(x + 1)
arrAutoTextValue(x + 1) = SwapFH1

AnyChanges = True
End If
Next x
Loop Until Not AnyChanges
---
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top