better method for accenting every word in Word document? - vb.net

I am new to programming, but I am trying to adapt an existing script as a MS Word 2010/2013 addin to add correct stress accentuation to every Latin word in an open document.
The script "DoAccentuate" returns an accented word for any unaccented Latin word I send it as a string. I just need help doing a better job of looping through all the words, and then stopping the loop when the last word is reached. My current method is a bit goofy...I insert a nonesense word at the end of the document and then loop until it gets selected and accented.
Perhaps there's a better or more efficient way to go about the whole thing.
Public Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
Dim document As Word.Document
document = Globals.ThisAddIn.Application.ActiveDocument
Dim mySelection = document.Application.Selection
'make sure cursor is at start of document
document.Application.Selection.HomeKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdStory)
'insert fake word at end to stop the loop
Dim range As Word.Range
range = document.Range()
range.InsertAfter(" documentendatoris")
Do
'use MS Word's wildcard to select the first individual word as trimmed string
mySelection.Find.Text = "<*>"
mySelection.Find.MatchWildcards = True
mySelection.Find.Execute()
'replace the selected word that has been found with its accented counterpart
mySelection.Text = Accentuate.Accentuate.DoAccentuate(mySelection.Text)
Loop Until mySelection.Text = "documentendatóris"
End Sub

Well, I don't realy know if its more efficient way but you could use document.Content and range.Words collection to check all words in main story range
document = Globals.ThisAddIn.Application.ActiveDocument
Dim range As Word.Range
range = document.Content
Dim current As Integer
current = 0
Dim words As Word.Words
words = range.Words
Dim word As Word.Range
Do
current = current + 1
If current < words.Count Then
word = words(current)
If word.Text.EndsWith(" ") Then
word.Text = word.Text.Trim() + "'s "
'replace the selected word that has been found with its accented counterpart
'mySelection.Text = Accentuate.Accentuate.DoAccentuate(mySelection.Text)
Else
word.Text = word.Text.Trim() + "'s"
End If
End If
Loop Until current = words.Count

Related

VBA - Word change the concept of word(a.b is one word or two)

I have a question: i want to have an array of words of a WORD document, which are larger than 29 and Shorter than 40 characters. I implemented it in VBA this way:
Sub function()
Dim arr(1000) As String
counter = 0
For Each sentence In ActiveDocument.StoryRanges
For Each w In sentence.Words
If Len(w) > 28 And Len(w) < 40 Then
arr(counter) = w
counter = counter + 1
End If
Next
Next
End Sub
The Problem is that I want all words with char '_' cosidered as one word; for example: 'Adrian_link_mart' is one word and not 3: 'Adrian' and 'link' and 'mart' like it will be considered
thanks for your help, adrian
This may help. There is a bit of a wrinkle as you will see below.
Option explicit
Sub test()
' Use a collection rather than an array as we don't need
' to know the size in advance
Dim word_array As Collection
' Word doesn't actually have a 'word' object. Probably because
' that clashes with Word the application. So instead of Word.Word
' we are using word.range which gives us all the utility we will
' need
Dim my_word_range As Word.Range
Dim my_range As Word.Range
For Each my_range In ActiveDocument.StoryRanges
For Each my_word_range In my_range.Words
With my_word_range
Do While .Next(unit:=wdCharacter) = "_"
' '_' is considered to be a word by Word so we need to
' count two Word words to get to the end of the next
' text word IYSWIM
.MoveEnd unit:=wdWord, Count:=2
Loop
If .Characters.Count > 28 And .Characters.Count < 40 Then
word_array.Add Item:=.Text
End If
End With
Next
Next
End Sub
If you are new to VBA then
Include Option explicit at the top of every module
In the VBA IDE go Tools.Option.Editor.Code Settings and make sure every box is ticked.
Learn how to use F1. In the VBA IDE, putting the cursor on a keyword and pressing F1 will bring up the MS help page for that keyword

Find each word marked as error

Is it possible to find words that MS-Word marks as errors?
My goal is to find words containing "è" instead of "é", but to use a macro I need to replace the char only into words marked as error.
I'm working on MS-Word 2013
here is some code to get you started. you need to add code that checks for the "bad" letter
' this is just demo code that shows how misspelled words could be replaced
' create document with a few words, one or two misspelled
' then single-step this code using F8 key
' while watching the text in the document
Sub aaaaaa()
Dim i As Integer
Dim badChr As String
Dim badWrd As String
Dim wrd As Object
For Each wrd In ActiveDocument.Words
If wrd.SpellingErrors.Count > 0 Then
badWrd = wrd.SpellingErrors(1).Text
Debug.Print badWrd
wrd.SpellingErrors(1).Text = string(len(badWrd),"x") ' replace whole word if you like
wrd.SpellingErrors(1).Text = badWrd ' put back original
For i = 1 To wrd.SpellingErrors(1).Characters.Count ' loop characters in misspelled word
badChr = wrd.SpellingErrors(1).Characters(i).Text
wrd.SpellingErrors(1).Characters(i).Text = "x" ' replace character
wrd.SpellingErrors(1).Characters(i).Text = badChr ' restore character
Next i
End If
Next wrd
End Sub

Retrieve info from Word tables

I've got a Word document with a section surrounded by hidden text tags < Answers > ...some tables... < /Answers >. A Word macro can return the range of the text between these tags (used to be bookmarks but they had to go).
What I want to do from Excel is open the Word document, get the range between the tags, iterate the tables in that block and retrieve some cells from each row. Those cell data is then written in some rows on a new Excel sheet.
I saw many Word/Excel automation but none that inspired me to retrieve that range between two pieces of text. Best would be to be able to run the Word macro RetrieveRange(strTagName, rngTextBlock) in Word to return the range in rngTextBlock for "Answers" but this seems impossible.
As background: the .docm file is an exam paper with answers and maximum points that I 'd like to transfer into Excel to contain gradings for each student.
Browsing though some more sites, I encountered a C# example that partly did what I needed: rather than using Word's SELECTION stick to ranges to find something. I now can find the text block between the two tags, but still fail on traversing its tables and table rows. No compiler error (and working in Word itself) but I must be missing an external link...
Function CreateSEWorksheet() As Boolean
' Find <ANSWERS> in Word Document, and traverse all tables and write them as rows in worksheet
Dim wdrngStart As Word.Range
Dim wdrngEnd As Word.Range
Dim wdrngAnswers As Word.Range
Dim wdTable As Word.Table
Dim wdRow As Word.Row
Dim strStr As String
Dim bGoOn As Boolean
' Following set elsewhere:
' Set WDApp = GetObject(class:="Application.Word")
' Set WDDoc = WDApp.Documents.Open(filename:="filespec", visible:=True)
Set wdrngStart = WDDoc.Range ' select entire document - will shrink later
Set wdrngEnd = WDDoc.Range
Set wdrngAnswers = WDDoc.Range
' don't use Word SELECT/SELECTION but use ranges instead when finding tags.
If wdrngStart.Find.Execute(findText:="<ANSWERS>", MatchCase:=False) Then
' found!
wdrngAnswers.Start = wdrngStart.End
If wdrngEnd.Find.Execute(findText:="</ANSWERS>", MatchCase:=False) Then
wdrngAnswers.End = wdrngEnd.Start
bGoOn = True
Else
' no closing tag found
bGoOn = False
End If
Else
'no opening tag found
bGoOn = False
End If
If bGoOn Then
For Each wdTable In wdrngAnswers.Tables
' ** below doesn't work anymore: object doesn't support this method **
For Each wdRow In wdTable
' as example, take column 4 of each row
strStr = wdRow.Cells(4).Range.Text
strStr = Left(strStr, Len(strStr) - 2) ' remove end of cell markers
Debug.Print strStr
Next
Next
CreateSEWorksheet = True
Else
CreateSEWorksheet = False
End If
End Function

How to write VBA to format sentence starting with // in Word 2016?

I have a 400+ page coding manual I use, and unfortunately turned off the green for all the comments in the manual. I can't undo it, as I hadn't noticed it until it was too late. Its ruined years of work.
How would I write VBA to parse the document finding sentences starting with // and ending in a Paragraph mark and change the color of them? Or assign a style to them?
Here is a start that I have cobbled together, I admire people who can write code without intellisence, its like trying to find your way blindfolded
Dim oPara As Word.Paragraph
Dim rng As Range
Dim text As String
For Each oPara In ActiveDocument.Paragraphs
If Len(oPara.Range.text) > 1 Then
Set rng = ActiveDocument.Range(oPara.Range.Start,oPara.Range.End)
With rng.Font
.Font.Color = wdColorBlue
End With
End If
Next
End Sub
The following seems to work:
Dim oPara As Word.Paragraph
Dim text As String
For Each oPara In ActiveDocument.Paragraphs
text = oPara.Range.text
'Check the left 2 characters for //
If Left(oPara.Range.text, 2) = "//" Then
oPara.Range.text = "'" & text
End If
Next
I assume you are using VBA so by placing a ' in front of // it will turn the line green. You could modify the code to replace // with ' if desired. The opera.range.text should grab the entire paragraph.

VB.NET with Word - how to modify a paragraph indent after find

I am using VB.NET (VS2012) and Word (2013) with the Word 14 interop. Note: I am NOT using VBA within Word and can't use that as a solution.
I am trying to do a search and replace in the document for all instances of a key value pair and can do this easily with a Word.Document.Find.Execute() command.
However, what I also need to do is adjust the LeftIndent of the paragraph where the word is located because the replacement text is larger (eg "XXXXXXXXXX") than the text it is replacing (eg "XXXXX") and the area isn't large enough.
So I have been trying the following, but the paragraph indent is just not changing. Note: dicWords is just a Dictionary with my find/replace words.
Imports Microsoft.Office.Interop.Word
' Open Word document
Dim WordApp As New Application
Dim WordDoc As Document = WordApp.Documents.Open(WordFile.FullName, False, True, False)
' Loop through the dictionary of parts and find/replace
Dim pair As KeyValuePair(Of String, String)
For Each pair In dicWords
' Replace text
Dim bFound As Boolean = False
Do
' Do Search
bFound = WordDoc.Content.Find.Execute(FindText:=pair.Key, ReplaceWith:=pair.Value, Replace:=WdReplace.wdReplaceOne, Wrap:=WdFindWrap.wdFindContinue)
If bFound = True Then
' The range should be set from above Find, so now set the LeftIndent
WordDoc.Content.ParagraphFormat.LeftIndent = 5
End If
Loop While bFound = True
Next
However, the above isn't working.
Try:
WordDoc.Selection.Range.ParagraphFormat.LeftIndent = 5