Help with a teaching assignment needed

[ArthurN]

Hi,
Hope that somebody can help me with the following: I need a macro to create
a cloze (or fill-in the gaps) assignment for my language class.
I have a pre-formatted documents with the following structure:
<heading 1>
<heading 2>
<story 1>
<heading 1>
<heading 2>
<story 2>
Now, each story has some words or phrases marked with, say, character style
“InlineVocabularyâ€.
I have to:
1. select all these words and phrases
2. move them to the end of the <story 1>
3. format them as a list, style “WordsToInsertâ€
4. sort the list
5. convert the list to two columns
6. remove these words and phrases from the story 1, substituting them by “1
_____†element
7. do the same to the second story, the third story, etc.
This should look something like this:
1.1 CALLING TECH SUPPORT
I recently (1). _________ for a new (2). _________ for my office, using (3).
_________.
1. DSL
2. ISP
3. Singed up

Actually, I have a macro, but it just doesn’t work as expected and something
is wrong with the sorting part:

Sub Vocabulary()
'
' AutoExit.MAIN Macro
'
'
Dim rDcm As Range
Dim LCnt As Long
Set rDcm = ActiveDocument.Range
rDcm.InsertAfter vbCrLf
With rDcm.Find
.Style = "InlineVocabulary"
While .Execute
rDcm.Select ' for testing
ActiveDocument.Range.InsertAfter rDcm.Text & vbCrLf
ActiveDocument.Paragraphs.Last.Previous.Range.Style = "WordsToInsert"
Wend
End With
Set rDcm = ActiveDocument.Range
'With rDcm.Find
' .Style = "WordsToInsert"
' If .Execute Then
' rDcm.Select
' Selection.End = ActiveDocument.Range.End - 1
' Selection.Sort
' End If
'End With

Set rDcm = ActiveDocument.Range
With rDcm.Find
.Style = "InlineVocabulary"
While .Execute
LCnt = LCnt + 1
rDcm.Select ' for testing
rDcm.Text = "(" & CStr(LCnt) & ") _________"
rDcm.Collapse Direction:=wdCollapseEnd
Wend
End With

End Sub

Thanks in advance,
Arthur N

 

[Jean-Guy Marcil]

Hi,
Hope that somebody can help me with the following: I need a macro to create
a cloze (or fill-in the gaps) assignment for my language class.
I have a pre-formatted documents with the following structure:
<heading 1>
<heading 2>
<story 1>
<heading 1>
<heading 2>
<story 2>
Now, each story has some words or phrases marked with, say, character style
“InlineVocabularyâ€.
I have to:
1. select all these words and phrases
2. move them to the end of the <story 1>
3. format them as a list, style “WordsToInsertâ€
4. sort the list
5. convert the list to two columns
6. remove these words and phrases from the story 1, substituting them by “1
_____†element
7. do the same to the second story, the third story, etc.
This should look something like this:
1.1 CALLING TECH SUPPORT
I recently (1). _________ for a new (2). _________ for my office, using (3).
_________.
1. DSL
2. ISP
3. Singed up

Actually, I have a macro, but it just doesn’t work as expected and something
is wrong with the sorting part:

To make things easier, here is what I suggest:
1) Use "Continuous" (or "Next page"...) section breaks to separate each
story, no need for an actual section break after the last one.
2) Format the style "WordsToInsert" as follows: 3 tab stops, make sure you
have enough space between the first tab stop and the left margin for the
numbers the code inserts. Format the second tab stop with the underscore
leading charcter (Format > Tabs...). This will generate an automatic
underlining fro the "first column".

That's it!

Now play around with this code to get you going.

I am sure that there is a better way to do the sorting, but right now, all I
can think of is "Split", but "Split" only works with the "Variant" type, but
"SortArray" does not work with variants... so I have to convert the Variant
into a String... There must be a way to create the string directly...

Good luck!

Sub Vocabulary()

Dim rgeSec As Range
Dim strWords As String
Dim strArrWords As Variant
Dim strArrWordsSort() As String
Dim i As Long
Dim j As Long
Dim k As Long

For i = 1 To ActiveDocument.Sections.Count
j = 1
strWords = ""
Set rgeSec = ActiveDocument.Sections(i).Range
With rgeSec
.MoveEnd wdCharacter, -1
With .Find
.Style = "InlineVocabulary"
.Wrap = wdFindStop
Do While .Execute
strWords = strWords & .Parent.Text & "|"
.Parent.Text = "(" & j & ")._______________"
j = j + 1
rgeSec.SetRange .Parent.End + 1,
ActiveDocument.Sections(i).Range.End
Loop
End With
End With
strArrWords = Split(strWords, "|")
ReDim strArrWordsSort(UBound(strArrWords) - 1)
For k = 0 To UBound(strArrWords) - 1
strArrWordsSort(k) = strArrWords(k)
Next
WordBasic.SortArray strArrWordsSort(), 0, 0, k - 1, 0, 1
Set rgeSec = ActiveDocument.Sections(i).Range
With rgeSec
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
For k = 0 To UBound(strArrWordsSort)
.InsertAfter k + 1 & "." & vbTab & vbTab & vbTab &
strArrWordsSort(k) & vbCrLf
Next
.Style = "WordsToInsert"
End With
Next

End Sub

 

[ArthurN]

Thanks a lot for help,
Unfortunately, for some reason I can't run the script in the following lines:
rgeSec.SetRange .Parent.End + 1,
and
.InsertAfter k + 1 & "." & vbTab & vbTab & vbTab &
They give an error each time I try to run them.

* The stories in a documents are separated from each other by a page break.

Thanks again,
ArthurN

 

[Helmut Weber]

Hi Arthur,

Unfortunately, for some reason I can't run the script in the following lines:
rgeSec.SetRange .Parent.End + 1,
and
.InsertAfter k + 1 & "." & vbTab & vbTab & vbTab &
They give an error each time I try to run them.

The lines are probably too long,
so your newsreader wraps them.

Hit "delete" at the end of the line to unwrap them

or try

rgeSec.SetRange .Parent.End + 1, _
and
..InsertAfter k + 1 & "." & vbTab & vbTab & vbTab & _

--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

 

[Jean-Guy Marcil]

Thanks a lot for help,
Unfortunately, for some reason I can't run the script in the following lines:
rgeSec.SetRange .Parent.End + 1,
and
.InsertAfter k + 1 & "." & vbTab & vbTab & vbTab &
They give an error each time I try to run them.

* The stories in a documents are separated from each other by a page break.

Be careful when copying code from the internet/newsgroups. Often lines are
broken by the message browser.

Normally, you can easily spot those lines in the VBA editor because the code
is in red.

In this case,

rgeSec.SetRange .Parent.End + 1,
ActiveDocument.Sections(i).Range.End

should be on one line:

rgeSec.SetRange .Parent.End + 1, ActiveDocument.Sections(i).Range.End

Or, you can use the line continuing character:
rgeSec.SetRange .Parent.End + 1, _
ActiveDocument.Sections(i).Range.End


The same for:

.InsertAfter k + 1 & "." & vbTab & vbTab & vbTab &
strArrWordsSort(k) & vbCrLf

One line:

..InsertAfter k + 1 & "." & vbTab & vbTab & vbTab & strArrWordsSort(k) & vbCrLf

Or,

.InsertAfter k + 1 & "." & vbTab & vbTab & vbTab _
& strArrWordsSort(k) & vbCrLf

 

[ArthurN]

Thanks, everything works perfect.
The only thing it doesn't do is spliting the words at the end into two
columns, which would save a lot of space in whole document.
Another questions is about this line:
With rgeSec
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
For k = 0 To UBound(strArrWordsSort)
.InsertAfter k + 1 & "." & vbTab & vbTab & vbTab &
strArrWordsSort(k) & vbCrLf

Why did you add 3 tabs?

Thanks again,
ArthurN

 

[Jean-Guy Marcil]

Thanks, everything works perfect.
The only thing it doesn't do is spliting the words at the end into two
columns, which would save a lot of space in whole document.

Next time, may I suggest that you post a full example of expected results,
instead of

"1. DSL
2. ISP
3. Singed up"

You could have posted

"1. DSL 2. ISP
3. Singed up 4. Some other word"

This way a thick-headed coder like myself would not have misunderstood your
requirements! ;-)

This can be done, just work with this part of the code to insert the words
next to each other:

For k = 0 To UBound(strArrWordsSort)
.InsertAfter k + 1 & "." & vbTab & vbTab & vbTab & _
strArrWordsSort(k) & vbCrLf
Next
..Style = "WordsToInsert"

etc.

You could look up the "ConvertToTable" method in the VBA help...
Hint... use a unique character like "|" to separate the cells as you will
need the tab to separate the digits from the words... (See the "Separator"
parameter of the "ConvertToTable" method in the VBA help.)
Also, in this case, create the table and then apply the "WordsToInsert"
style to the table content...

This might be a fun and useful exercice...

Another questions is about this line:
With rgeSec
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
For k = 0 To UBound(strArrWordsSort)
.InsertAfter k + 1 & "." & vbTab & vbTab & vbTab &
strArrWordsSort(k) & vbCrLf

Why did you add 3 tabs?

In your first post, you stated you wanted the words printed (after sorting
them) like this:

"1. DSL
2. ISP
3. Singed up"

I assumed that the space between the digit and the word was there for the
student to write the answer, or write something else; otherewise, why have a
large space?
So, in my first reply, I stated:

"2) Format the style "WordsToInsert" as follows: 3 tab stops, make sure you
have enough space between the first tab stop and the left margin for the
numbers the code inserts. Format the second tab stop with the underscore
leading charcter (Format > Tabs...). This will generate an automatic
underlining fro the "first column"."

I thought the two columns you spoke of was the space (for writing) and the
word. This method gave you an automatic underline space for the student to
write onto.
But, I just realized that the space may have been produced by the interface
when you typed a tab...the space is way too large at my end, may be not so at
your end of things...
If this is not necessary, remove two of the tabs and format your
"WordsToInsert" style appropriately.