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
Related
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
I am trying to build template invoices for Xero. Xero looks for specific fields in your MS Word template and inputs the variable assigned to that text field name in your given format. In word you can toggle the field code to view as just the field name:
«InvoiceNumber»
or the name with format:
{ MERGEFIELD InvoiceNumber \* MERGEFORMAT}
This outputs: INV1234 successfully into the template. Now what I need to do is output just the last 4 characters.
This post seems to imply it must be done with a VBA. I put together a macro with Visual Basic in word and this is where I have hit trouble:
Sub InvoiceNumber()
Dim MyInv As FormFields
Set MyInv = ActiveDocument.FormFields
If MyInv("Text1").Result = "InvoiceNumber" Then
MyInv("Text1").CheckBox.Value = Right(MyInv("Text1"), 4)
End If
End Sub
This returns with
error 5941: The requested member of the selection does not exist
I am quite a beginner with VB macros in word, what am I doing wrong and how should I instead be trying to call the InvoiceNumber Field?
Please try with the following solution:
Sub InvoiceNumber()
Dim MyInv As Field
Set MyInv = GetFieldByName("InvoiceNumber")
If Not MyInv Is Nothing Then
'do something with field result...
'here... debug to Immediate window
Debug.Print Right(MyInv.Result, 4)
End If
End Sub
Function GetFieldByName(fName As String) As Field
Dim F As Field
For Each F In ActiveDocument.Fields
'if not working try with (1) istead of (2) in line below
If Split(Replace(F.Code, " ", " "), " ")(2) = fName Then
Set GetFieldByName = F
Exit Function
End If
Next F
Set GetFieldByName = Nothing
End Function
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
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
My junk mail folder has been filling up with messages composed in what appears to be the Cyrillic alphabet. If a message body or a message subject is in Cyrillic, I want to permanently delete it.
On my screen I see Cyrillic characters, but when I iterate through the messages in VBA within Outlook, the "Subject" property of the message returns question marks.
How can I determine if the subject of the message is in Cyrillic characters?
(Note: I have examined the "InternetCodepage" property - it's usually Western European.)
The String datatype in VB/VBA can handle Unicode characters, but the IDE itself has trouble displaying them (hence the question marks).
I wrote an IsCyrillic function that might help you out. The function takes a single String argument and returns True if the string contains at least one Cyrillic character. I tested this code with Outlook 2007 and it seems to work fine. To test it, I sent myself a few e-mails with Cyrillic text in the subject line and verified that my test code could correctly pick out those e-mails from among everything else in my Inbox.
So, I actually have two code snippets:
The code that contains the IsCyrillic function. This can be copy-pasted
into a new VBA module or added to
the code you already have.
The Test routine I wrote (in Outlook VBA) to test that the code actually works. It demonstrates how to use the IsCyrillic function.
The Code
Option Explicit
Public Const errInvalidArgument = 5
' Returns True if sText contains at least one Cyrillic character'
' NOTE: Assumes UTF-16 encoding'
Public Function IsCyrillic(ByVal sText As String) As Boolean
Dim i As Long
' Loop through each char. If we hit a Cryrillic char, return True.'
For i = 1 To Len(sText)
If IsCharCyrillic(Mid(sText, i, 1)) Then
IsCyrillic = True
Exit Function
End If
Next
End Function
' Returns True if the given character is part of the Cyrillic alphabet'
' NOTE: Assumes UTF-16 encoding'
Private Function IsCharCyrillic(ByVal sChar As String) As Boolean
' According to the first few Google pages I found, '
' Cyrillic is stored at U+400-U+52f '
Const CYRILLIC_START As Integer = &H400
Const CYRILLIC_END As Integer = &H52F
' A (valid) single Unicode char will be two bytes long'
If LenB(sChar) <> 2 Then
Err.Raise errInvalidArgument, _
"IsCharCyrillic", _
"sChar must be a single Unicode character"
End If
' Get Unicode value of character'
Dim nCharCode As Integer
nCharCode = AscW(sChar)
' Is char code in the range of the Cyrillic characters?'
If (nCharCode >= CYRILLIC_START And nCharCode <= CYRILLIC_END) Then
IsCharCyrillic = True
End If
End Function
Example Usage
' On my box, this code iterates through my Inbox. On your machine,'
' you may have to switch to your Inbox in Outlook before running this code.'
' I placed this code in `ThisOutlookSession` in the VBA editor. I called'
' it in the Immediate window by typing `ThisOutlookSession.TestIsCyrillic`'
Public Sub TestIsCyrillic()
Dim oItem As Object
Dim oMailItem As MailItem
For Each oItem In ThisOutlookSession.ActiveExplorer.CurrentFolder.Items
If TypeOf oItem Is MailItem Then
Set oMailItem = oItem
If IsCyrillic(oMailItem.Subject) Then
' I just printed out the offending subject line '
' (it will display as ? marks, but I just '
' wanted to see it output something) '
' In your case, you could change this line to: '
' '
' oMailItem.Delete '
' '
' to actually delete the message '
Debug.Print oMailItem.Subject
End If
End If
Next
End Sub
the "Subject" property of the message returns a bunch of question marks.
A classic string encoding problem. Sounds like that property is returning ASCII but you want UTF-8 or Unicode.
It seems to me you have an easy solution already - just look for any subject line with (say) 5 question marks in it