I want to reverse words in a Word document like this: "elpmaS texT" becomes "Sample Text".
I tried something like this:
For Each word In ActiveDocument.Words
word = StrReverse(word)
Next word
However it doesn't work.
How can I do this?
When you are using a for each loop, you are unable to change the word, so use a for loop:
Dim i As Integer
For i = 1 To ActiveDocument.Words.Count Step 1
ActiveDocument.Words(i) = StrReverse(ActiveDocument.Words(i)) & " "
Next i
Sub ReverseSelectedWords()
Dim i As Integer
Dim oWords As Words
Dim oWord As Range
Set oWords = Selection.Range.Words
For i = 1 To oWords.Count Step 1
Set oWord = oWords(i)
''Make sure the word range doesn't include a space
Do While oWord.Characters.Last.text = " "
Call oWord.MoveEnd(WdUnits.wdCharacter, -1)
Loop
Debug.Print "'" & oWord.text & "'"
oWord.text = StrReverse(oWord.text)
Next i
End Sub
Related
I have a *.docx file with more than 4000 endnotes. My task is to combine endnotes inside every paragraph (where there is 3 and more endnotes) to one big endnote.
For example.
Input:
word word{1} word{2} word word{3} word.
Endnotes:
{1} endnote
{2} endnote
{3} endnote
Output:
word word word word word word{1}.
Endnotes:
{1} endnote; endnote; endnote
So I'll have one big endnote instead of several small ones.
What I have tried:
Sub Macro1()
Dim i As Integer
Dim t As String
Dim tmp As String
tmp = ""
For i = 1 To Selection.Endnotes.Count Step 1
t = Selection.Endnotes(i).Range.Text
If tmp = "" Then
tmp = Selection.Endnotes(i).Range.Text
Else
tmp = tmp & "; " & Selection.Endnotes(i).Range.Text
End If
Next i
For i = Selection.Endnotes.Count To 1 Step -1
Selection.Endnotes(i).Delete
Next i
Selection.Expand wdParagraph
ActiveDocument.Endnotes.Add Range:=Selection.Range, Text:=tmp
End Sub
It works but a user must select proper paragraph by hand. What I don't know is how to do this process automatically - find bad paragraphs with more than 3 endnotes and apply the code above to these paragraphs. ActiveDocument.Paragraphs item don't have Endnotes property.
Please help)
So the decision is:
Sub Macro1()
Dim i As Integer
Dim t As String
Dim tmp As String
Dim p As Paragraph
For Each p In ActiveDocument.Paragraphs
If p.Range.Endnotes.Count > 3 Then
tmp = ""
For i = 1 To p.Range.Endnotes.Count Step 1
t = p.Range.Endnotes(i).Range.Text
If tmp = "" Then
tmp = t
Else
tmp = tmp & "; " & t
End If
Next i
For i = p.Range.Endnotes.Count To 1 Step -1
p.Range.Endnotes(i).Delete
Next i
ActiveDocument.Endnotes.Add Range:=p.Range, Text:=tmp
End If
Next p
End Sub
I am trying to create a macro that will import specific email items from my inbox and everything works perfect until it breaks at the email with subject line "=?ANSI_X3.4-1968?Q?......".
It seems like the email was originally written in other language and somehow it gets converted into a block of special characters that macro can't recognize. Please see the code below. Your helps will be highly appreciated!
sub search_inbox()
Range("A2:D60").ClearContents
Dim ol as Outlook.Application
Dim ns as Outlook.Namespace
Dim fol as Outlook.Folder
Dim i as Object
Dim mi as Outlook.MailItem
Dim rh as Double
Dim START_DATE as Date
Dim x as Long
Dim sh as Worksheet
set sh = ThisWorkbook.Sheets("Test")
set ol = New Outlook.Application
set ns = ol.GetNamespace("MAPI")
set fol = ns.Folders(sh.Range("M1").value).Folders(sh.Range("M2").value)
START_DATE = sh.range("J8") + sh.range("J9")
END_DATE = sh.range("K8") + sh.range("K9")
for Each i in fol.items
if i.SentOn >= START_DATE And i.SentOn <= END_DATE And i.Class = olMail Then
n = n + 1
set mi = i
Cells(n+1, 1).Value = mi.SenderName
Cells(n+1, 2).Value = mi.Subject
Cells(n+1, 3).Value = mi.SenderEmailAddress
Cells(n+1, 4).Value = mi.ReceivedTime
Cells(n+1, 5).Value = mi.Categories
Cells(n+1, 6).Value = mi.Size
Else
End If
Next i
MsgBox (x - 1)
End Sub
The procedure below first creates a test string Subject and then analyses it. It looks at every character in turn. If it's a double width character it replaces it with a question mark. Finally, it issues a few message boxes about the result.
Private Sub FindSpecials()
' 262
Dim Subject As String ' test string
Dim Result As String ' Message string
Dim Char As String ' one character of Subject
Dim n As Integer ' loop counter: characters
Dim Revised As String ' Subject without special characteres
Subject = "Email about " & ChrW(19978) & ChrW(28023) & " traffic"
For n = 1 To Len(Subject)
Char = Mid(Subject, n, 1)
If Asc(Char) <> AscW(Char) Then
Result = Result & vbCr & "Character " & AscW(Char) & " = " _
& Char & " in position " & n
Revised = Left(Subject, n - 1) & "?" & Mid(Subject, n + 1)
End If
Next n
If StrComp(Subject, Revised) Then
MsgBox "The following special characters were found" & Result
MsgBox "This is the revised subject:" & vbCr & _
"""" & Revised & """"
Else
MsgBox "No double-width characters were found"
End If
End Sub
Applied to your project, the test string Subject should be created from mi.Subject, of course. The output Result can be discarded but the string Revised might be useful to you. Of course, you might replace the double width characters with something other than a question mark. My code just intends to demonstrate how the special characters can be extracted and replaced.
Book endnotes often forgo superscript numbers for page numbers. E.g., instead of
Abe Lincoln was assassinated with a pistol.^33
:
33. A single-shot derringer pistol.
books by several authors write
Abe Lincoln was assassinated with a pistol.
:
Page 297. Abe Lincoln was shot single-shot derringer pistol.
Word doesn't have this feature, so I believe it would have to be a Macro. I came up with simple code below that loops through all of the endnotes and adds
"Page ???. "
before each endnote, but what does "???" need to be to correctly insert the page number in my manuscript that the citation's located on?
Sub RedefineExistingEndNotes()
Dim fn As Endnote
For Each fn In ActiveDocument.Endnotes
fn.Range.Paragraphs(1).Range.Font.Reset
fn.Range.Paragraphs(1).Range.Characters(1).InsertBefore "Page" & "???" & " - "
Next fn
End Sub
Try the below VBA code:
Sub InsertPageNumberForEndnotes()
Dim endNoteCount As Integer
Dim curPageNumber As Integer
If ActiveDocument.Endnotes.Count > 0 Then
For endNoteCount = 1 To ActiveDocument.Endnotes.Count
Selection.GoTo What:=wdGoToEndnote, Which:=wdGoToAbsolute, Count:=endNoteCount
curPageNumber = Selection.Information(wdActiveEndPageNumber)
ActiveDocument.Endnotes(endNoteCount).Range.Select
ActiveDocument.Application.Selection.Collapse (WdCollapseDirection.wdCollapseStart)
ActiveDocument.Application.Selection.Paragraphs(1).Range.Characters(1).InsertBefore "Page " & CStr(curPageNumber) & " - "
Next
End If
End Sub
An alternative might be to use PAGEREF fields and hide the endnote references, e.g.
Sub modifyEndNotes()
Const bookmarkText As String = "endnote"
Dim en As Word.Endnote
Dim rng As Word.Range
For Each en In ActiveDocument.Endnotes
en.Reference.Bookmarks.Add bookmarkText & en.Index
en.Reference.Font.Hidden = True
Set rng = en.Range
rng.Paragraphs(1).Range.Font.Hidden = True
rng.Collapse WdCollapseDirection.wdCollapseStart
rng.Text = "Page . "
rng.SetRange rng.End - 2, rng.End - 2
rng.Fields.Add rng, WdFieldType.wdFieldEmpty, "PAGEREF " & bookmarkText & en.Index & " \h", False
'if necessary...
'rng.Fields.Update
en.Range.Font.Hidden = False
Next
Set rng = Nothing
End Sub
For a second run, you'd need to remove and re-insert the text and fields you had added.
Unfortunately, a further look suggests that it would be difficult, if not impossible, to hide the endnote references (in the endnotes themselves) without hiding the paragraph marker at the end of the first endnote para, which means that all the endnotes will end up looking like a single messy note. So I deleted this Answer.
However, the OP thought the approach could be modified in a useful way so I have undeleted. I can't re-research it right away but some possibilities might be to replace every endnote mark by a bullet (as suggested by the OP) or perhaps even something as simple as a space or a "-".
For example, something like this (which also hides the references using a different technique)...
Sub modifyEndNotes2()
' this version also formats the endnotes under page headings
Const bookmarkText As String = "endnote"
Dim en As Word.Endnote
Dim f As Word.Field
Dim i As Integer
Dim rng As Word.Range
Dim strSavedPage As String
strSavedPage = ""
For Each en In ActiveDocument.Endnotes
en.Reference.Bookmarks.Add bookmarkText & en.Index
Set rng = en.Range
rng.Collapse WdCollapseDirection.wdCollapseStart
If CStr(en.Reference.Information(wdActiveEndPageNumber)) <> strSavedPage Then
strSavedPage = CStr(en.Reference.Information(wdActiveEndPageNumber))
rng.Text = "Page :-" & vbCr & " - "
rng.SetRange rng.End - 6, rng.End - 6
rng.Fields.Add rng, WdFieldType.wdFieldEmpty, "PAGEREF " & bookmarkText & en.Index & " \h", False
rng.Collapse WdCollapseDirection.wdCollapseEnd
Else
rng.Text = "- "
End If
Next
If ActiveDocument.Endnotes.Count > 1 Then
ActiveDocument.Styles(wdStyleEndnoteReference).Font.Hidden = True
Else
ActiveDocument.Styles(wdStyleEndnoteReference).Font.Hidden = False
End If
Set rng = Nothing
End Sub
In the above case, notice that there is only one link to each page, that formatting might be needed to make it obvious that it is a link, and so on.
Context: I'm writing a Word VBA macro that loops through each word in a document, identifies the acronyms, and creates an acronym list as a new document. The next step is to identify whether the acronym is in parentheses (meaning it's likely spelled out) on its first occurrence. So, I'd like to expand the range to find out whether the characters on either side of the word are "(" and ")".
Issue: I can't figure out how to assign the range of the word to a range variable that I can then expand. Using "rngWord = ActiveDocument.Words(k)" (where k is the counter variable) gets the error #91, Object Variable or With block variable not set. So presumably there's a method or property for Words that I'm missing. Based on Microsoft's VBA reference, though, the members of the Words collection are already ranges, so I'm stumped on why I can't assign one to a range variable.
Dim intArrayCount As Integer
Dim booAcroMatchesArray As Boolean
Dim intNextAcro As Integer
Dim strAcros(1000) As String
Dim strContext(1000) As String
Dim booAcroDefined(1000) As Boolean
Dim strTestMessage As String
i = 1
booAcroMatchesArray = False
intNextAcro = 1
For k = 1 To ActiveDocument.Words.Count
strWord = ActiveDocument.Words(k).Text
rngWord = ActiveDocument.Words(k) //The line that's missing something
MsgBox strWord
rngWord.Expand Unit:=wdCharacter
strWordPlus = rngWord
MsgBox strWordPlus
strWord = Trim(strWord)
If strWord = UCase(strWord) And Len(strWord) >= 2 And IsLetter(Left(strWord, 1)) = True Then
'MsgBox ("Word = " & strWord & " and Length = " & Len(strWord))
For intArrayCount = 1 To 1000
If strWord = strAcros(intArrayCount) Then booAcroMatchesArray = True
Next intArrayCount
'MsgBox ("Word = " & strWord & " Match = " & booAcroMatchesArray)
If booAcroMatchesArray = False Then
strAcros(intNextAcro) = strWord
intNextAcro = intNextAcro + 1
End If
booAcroMatchesArray = False
End If
Next k
Object variables need to be assigned using Set. Instead of:
rngWord = ActiveDocument.Words(k)
use
Set rngWord = ActiveDocument.Words(k)
This small sample worked correctly:
Sub WordRangeTest()
Dim rngWord As Range
Set rngWord = ActiveDocument.Words(1)
MsgBox (rngWord.Text)
End Sub
I have a Word file that contains multiple people and their details.
I need to split this file into single files for each person.
This is the code, most of it is from examples I found.
I need to split the file by the delimiter (Personal).
Each file needs to be named by their ID number situated just below the delimiter.
Sub SplitNotes (delim As String)
Dim sText As String
Dim sValues(10) As String
Dim doc As Document
Dim arrNotes
Dim strFilename As String
Dim Test As String
Dim I As Long
Dim X As Long
Dim Response As Integer
arrNotes = Split(ActiveDocument.Range, delim)
Response = MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections.Do you wish to proceed?", 4)
If Response = 7 Then Exit Sub
For I = LBound(arrNotes) To UBound(arrNotes)
If Trim(arrNotes(I)) <> "" Then
X = X + 1
Set doc = Documents.Add
doc.Range = arrNotes(I)
'Find "EID: "
doc.Range.Find.Text = "EID: "
'Select whole line
Selection.Expand wdLine
'Assign text to variable
sText = Selection.Text
'Remove spaces
sText = Replace(sText, " ", "")
'Split string into values
sValues = Split(sText, ":")
strFilename = "Testing"
doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "Agent")
doc.Close True
End If
Next I
End Sub
Sub Test()
'delimiter
SplitNotes "Name:"
End Sub
The Word document is set out as follows:
Personal
Name: John Smith
EID: Alph4num3r1c (Not a set length as i know of)
Details follow on from here
My problem is getting the ID number and using it in the save as function.
I don't have a complete understanding of how the split function works.
Split function splits a string into array of strings based on a delimeter.
For eg:
Dim csvNames, arrNames
csvNames = "Tom,Dick,Harry"
arrNames = split(csvNames,",")
Now arrNames is an array containing 3 elements. You can loop through the elements like this:
Dim i
For i = 0 to UBound(arrNames)
response.write arrNames(i) & "<br />"
Next
Now applying split function to solve your problem.
Read the line you are interested in into a variable. Lets say we have,
Dim lineWithID, arrKeyValuePair
lineWithID = "EID: Alph4num3r1c"
Split it into an array using colon
arrKeyValuePair = Split(lineWithID,":")
Now, arrKeyValuePair(1) will contain your EID
If your question is still valid I have some solution regarding file name you search.
I didn't check all part of your code (so I did but I don't have your original document to make full analysis). Back to file name- you could use below simple logic to extract name from newly created doc:
'...beginning of your code here
'next part unchanged >>
For I = LBound(arrNotes) To UBound(arrNotes)
If Trim(arrNotes(I)) <> "" Then
X = X + 1
Set doc = Documents.Add
doc.Range = arrNotes(I)
'<<until this moment
'remove or comment your code here!!
'and add new part of the code to search for the name
Selection.Find.Execute "EID:"
Selection.MoveRight wdWord, 1
Selection.Expand wdWord
strFilename = Trim(Selection.Text)
'and back to your code- unchanged
doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "Agent")
doc.Close True
End If
Next I
'...end of sub and other ending stuff
I check it and works quite ok for me.