In MS Word (Office for Mac 2016, version 15.31) I would like to enrich a document by marking spelling errors and by writing the first spelling suggestion next to each misspelled word: for example if the text says
I wuld like to enrich
the result I need is
I [wuld][would] like to enrich
I know that
iErrorCnt=Doc.This.SpellingErrors.Count
For J=1 to iErrorCnt
Selection.TypeText Text:=DocThis.SpellingErrors(J)
Next J
will go through all spelling errors, and I know that
ActiveDocument.Words(1).GetSpellingSuggestions.Item(1).Name
allows to obtain the first spelling suggestion for a given word. But how do I link the misspelled word and the spelling suggestion (since the spelling suggestion is applied to words and words are indexed by integers) and how do I get them both marked in the document?
Try:
Sub SpellCheck()
Dim Rng As Range, oSuggestions As Variant
For Each Rng In ActiveDocument.Range.SpellingErrors
With Rng
If .GetSpellingSuggestions.Count > 0 Then
Set oSuggestions = .GetSpellingSuggestions
.Text = "[" & .Text & "][" & oSuggestions(1) & "]"
Else
.Text = "[" & .Text & "][]"
End If
End With
Next
End Sub
Related
I have some highlighted sections in a WORD document that I'm looking to aggregate into a new document, but I'd like to insert a pipe (shift backslash) before and after each unique highlighted section to facilitate import into another program.
I've been able to select and copy these highlighted sections into the new document with the following process:
Find > Advanced Find > More > Format > Highlight > Find in > Main Document > Close > Ctl+C > Ctl+N > Ctl+V
That process puts all of just my highlighted text into a new document.
My end goal is to have those same highlighted sections surrounded by the pipe characters.
I hope this clearly explains my "end game". Thanks in advance for the help!
You could try something like the following code:
Sub CopyHighlightedText()
Dim rng As Range
Dim str As String
Set rng = ActiveDocument.Range
With rng.Find
.ClearFormatting
.Highlight = True
While .Execute(Forward:=True, Format:=True)
str = str & " | " & rng.Text
Wend
End With
Documents.Add DocumentType:=wdNewBlankDocument
Selection.TypeText Text:=str
End Sub
I try to use Find.FindText in Word VBA to find the first few letters of a word, then select the rest of that word. For example, if I have:
"Hello , AB-1234-123 check"
I would find "AB-" then select the rest of the word to get "AB-1234-123". I cannot use space as my MoveEndUntil(" ") because, sometimes, the word ends with a period.
So far, my code is
SearchString = "AB-"
With Rng.Find
Do While .Execute(FindText:=SearchString, Forward:=True) = True
Rng.MoveEndUntil (" ")
MsgBox (Rng.Text)
Loop
End With
You can still use MoveEndUntil. If you look at the Help topic for the method, you'll see that the first parameter, named CSet, can hold multiple characters. So it can look for a space as well as a period, a comma, a semicolon, etc.
While testing your code, it also came to my attention that, as it stands, it will go into a continuous loop - always finding only the first instance. So I've taken care of that with the Collapse method so that the next Find sequence starts immediately after the last "found" range.
Dim rng As word.Range
Dim SearchString As String
Set rng = ActiveDocument.content
SearchString = "AB-"
With rng.Find
Do While .Execute(findText:=SearchString, Forward:=True) = True
rng.MoveEndUntil (" .,;!")
MsgBox rng.Text
rng.Collapse wdCollapseEnd
Loop
End With
Perhaps you can select the found word portion, then expand it to the whole word?
Selection.Expand Unit:=wdWord
I am using the following VBA macro to add page numbers after all bookmark hyperlinks in my document:
Sub InsertPageRefs()
Application.ScreenUpdating = False
Dim hLnk As Hyperlink, Rng As Range
For Each hLnk In ActiveDocument.Hyperlinks
With hLnk
If InStr(.SubAddress, "_Toc") = 0 And .Address = "" Then
Set Rng = .Range
With Rng
.Collapse Direction:=wdCollapseEnd
.InsertAfter Text:=" (See page #)"
.Font.Underline = wdUnderlineNone
End With
ActiveDocument.Fields.Add Range:=Rng.Characters(InStr(Rng, "#")), Text:="PAGEREF " & .SubAddress
End If
End With
Next
Set Rng = Nothing
Application.ScreenUpdating = True
Application.ScreenRefresh
MsgBox ActiveDocument.Hyperlinks.Count & " page numbers have been added.", vbOKOnly
End Sub
However, it's having undesirable results.
The blue color of the hyperlinks is partially spilling over into the added text.
It's creating a bunch of crazy span tags when I save the resulting file to HTML. I don't want this because I am going to convert the HTML to .mobi for Kindle and all the span tags are going to create chaos in my .mobi.
How do I strip out all the formatting and insert the page numbers in the "Normal" word style?
I suspect the real answer for this would be to use a good e-book editor that will keep track of this for you.
That said, the problem is likely that you are working on the Hyperlink's range, so all you should have to do is duplicate it. This allows the formatting of your range separate itself from whatever formatting is attached to the hyperlink. The other benefit of using a duplicate of a Hyperlink's range is that you can operate on the text of the range directly without destroying the link, which is also an easy way to preserve the target formatting:
Sub InsertPageRefs()
Dim hLnk As Hyperlink
Dim Rng As Range
For Each hLnk In ActiveDocument.Hyperlinks
If InStr(hLnk.SubAddress, "_Toc") = 0 And hLnk.Address = vbNullString Then
Set Rng = hLnk.Range.Duplicate
Rng.Start = Rng.End
Rng.Text = " (See page #)"
Rng.Font.Underline = wdUnderlineNone
ActiveDocument.Fields.Add Range:=Rng.Characters(InStr(Rng, "#")), _
Text:="PAGEREF " & hLnk.SubAddress
End If
Next
MsgBox ActiveDocument.Hyperlinks.Count & " page numbers have been added.", vbOKOnly
End Sub
Note that I pulled out the With blocks to make this more readable. Nested Withs make it a lot more difficult to tell at a glance what object you're operating on.
I have a document with comments on a long interview transcript. I found a Macro on SO that let's me export those comments with the highlighted text. This is awesome but the output is terribly dull (plain text).
I need to know if and how to apply bold, italic and insert newlines. I have looked for like an hours now and because my VBA is terrible I have no reference for where to look other than keyword searches on "marco output formatting"
Does someone know how to take the below script and font changes to parts of the text?
Sub ExportComments()
Dim s As String
Dim cmt As Word.Comment
Dim doc As Word.Document
For Each cmt In ActiveDocument.Comments
s = s & "Text: " & cmt.Scope.FormattedText & " -> "
s = s & "Comments: " & cmt.Initial & cmt.Index & ":" & cmt.Range.Text & vbCr
Next
Set doc = Documents.Add
doc.Range.Text = s
End Sub
Maybe I can do it with HTML interpreted by Word?
I'm assuming that the formatting you want included is already within the comment text, and that you are just looking for a way to get that into your final document. Here is a modified version of your script that will do that (with one caveat, listed below):
Sub ExportComments()
Dim cmt As Comment
Dim newdoc As Document
Dim currDoc As Document
Set currDoc = ActiveDocument
Set newdoc = Documents.Add
currDoc.Activate
For Each cmt In currDoc.Comments
With newdoc.Content
cmt.Scope.Copy
.InsertAfter "Text: "
.Collapse wdCollapseEnd
.Paste
.InsertAfter " - > "
cmt.Range.Copy
.InsertAfter "Comments: " & cmt.Initial & cmt.Index & ":"
.Collapse wdCollapseEnd
.Paste
.InsertParagraphAfter
End With
Next
End Sub
The difference here is that I'm using Copy and Paste rather than generating text strings.
Caveat: As the macro is written right now, any character formatting from the Scope (the text that appears next to Text in your file) will be applied to the arrow and the initials as well. This is pretty easy to fix with a search and replace, so I didn't incorporate it into the script.
I have a long list of terms. Over 90% are misspellings. Most of which are two words that have no space in the middle. I noticed that MS Word, Excel, Office, etc. is pretty good at suggesting the correct spelling. When I run the spellchecker, I don't have time to confirm each and every suggested correction. Having some errors are OK.
How can I automate spellcheck, or rather "spellcorrect" without prompting? I don't mind using other tools besides Microsoft, but it's spellchecker seems pretty good. I tried some VBA code to use with Excel, but I can't find anything that will programmatically show me the main suggestion so that I can replace the misspelled term.
Sub spellcheck()
With Application.SpellingOptions
.SuggestMainOnly = True
.IgnoreCaps = True
.
End With
Cells.CheckSpelling
End Sub
Any help is appreciated. And please I understand the danger of auto-correct. The impact of wrongful corrections is minimal.
Thanks,
Steve
A third party spell checker, such as aspell might give you the most speed & flexibility. But apparently, you can control the spell checker of Access, so that might be a possibility.
Given your special case of errors being due to lack of space between two words though, you may be able to get by with Excel's spell checker:
Sub test()
Dim str, correction As String
Dim i As Long, n As Long
With Application
For Each str In Array("pancake", "sausagebiscuit", "oatmeal", "largecoffee")
correction = str ' by default leave alone
If .CheckSpelling(str) Then
' already a word
Else
n = Len(str)
For i = 1 To n
If .CheckSpelling(Left$(str, i)) And .CheckSpelling(Right$(str, n - i)) Then
correction = Left$(str, i) & " " & Right$(str, n - i)
End If
Next
End If
Debug.Print str & " -> " & correction
Next
End With
End Sub
Output:
pancake -> pancake
sausagebiscuit -> sausage biscuit
oatmeal -> oatmeal
largecoffee -> large coffee
Mmmm, breakfast....
Assuming that you have a list of misspelled words in column A (starting in row 1) and their corrections in column B, you can use this macro to add them the Office's Autocorrect library. This way, Excel will replace the word with its correction right after the word is entered.
Sub subAddAutoCorrects()
Dim rng As Range
Set rng = Sheets("Sheet1").Range("A1")
While rng ""
Application.AutoCorrect.AddReplacement What:=rng.Value, Replacement:=rng.Offset(, 1).Value
Set rng = rng.Offset(1)
Wend
End Sub
It's been more than a year, but maybe you still need the solution to the problem.
Try this (in ms word):
Sub use_suggestion()
Dim rng As Range
Dim i As Long
For i = 1 To ActiveDocument.Range.SpellingErrors.Count
Set rng = ActiveDocument.Range.SpellingErrors(i)
If rng.GetSpellingSuggestions.Count <> 0 Then
rng = rng.GetSpellingSuggestions.Item(1).Name & "ZXQ"
End If
Next i
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "ZXQ"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Note: the misspelled words that have no suggestion will not change.