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
Related
i have following problem. Im currently creating a Macro that gets every font thats been used in a Word document. Afterwards it checks, if this font is even installed and changes the font into predefined fonts. (As the Microsoft auto-font-change in Word is pretty bad and changes my fonts into Comic Sans (no joke ...).
Everything works as intended except for one thing.
This here is the code i am using to exchange every occurence of the found
font in the document:
For i = 0 To UBound(missingFont)
For Each oCharacter In ActiveDocument.Range.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
So basically im checking every Character in my document and change it if needed. Now this only works for Characters that are not inside of textfields, the header or footer. How can i check every, EVERY, character inside of the Document?
First i've tried to use ActiveDocument.Range.Paragraphs instead of ActiveDocument.Range.Characters. I've also tried using the macro given here: http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldnt get this to work at all.
It's not clear what is meant by "textfield" as that could be any of five or six different things in Word...
But there is a way to access almost everything (excluding ActiveX controls) in a Word document by looping all StoryRanges. A StoryRange includes the main body of the document, headers, footers, footnotes, text ranges in Shapes, etc.
The following code sample demonstrates how to loop all the "Stories" in a document. I've put the code provided in the question in a separate procedure that's called from the "Stories" loop. (Note that I am not able to test, not having access to either the documents or relevant portions of code used in the question.)
Sub ProcessAllStories()
Dim doc as Word.Document
Dim missingFont as Variant
Dim myStoryRange as Word.StoryRange
'Define missingFont
Set doc = ActiveDocument
For Each myStoryRange In doc.StoryRanges
CheckFonts myStoryRange, missingFont
Do While Not (myStoryRange.NextStoryRange Is Nothing)
Set myStoryRange = myStoryRange.NextStoryRange
CheckFonts myStoryRange, missingFont
Loop
Next myStoryRange
End Sub
Sub CheckFonts(rng as Word.Range, missingFont as Variant)
Dim oCharacter as Word.Range
For i = 0 To UBound(missingFont)
For Each oCharacter In rng.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
End Sub
I've changed balloon comments to footnotes, taking the author's name too. I need the author's name to be in bold but I can't get my code to read the footnotes. My problem is in setting : oFootnote
I've tried calling on the strAuthor and making that bold but because it is no longer a comment.author I can no longer set it as it's now in the footnote. I've tried many examples on the internet but I just can't get them to work:
StackOverflow's How do i make a string bold; Insert bold text into Word using VBA
also
Set oFootnote = oDoc.Footnotes.Add(Range:=Selection.Range, Text:="Some text")
I am a trainee so please don't judge me too harshly
'Convert comments to footnotes with Author name in bold
Dim i As Long
Dim oDoc As Document
dim oComment as Comments
Dim oFootnote As Footnotes
'Document is the ActiveDocument
Set oDoc = Application.ActiveDocument
'the author's name needs to be bold (the last two words in each footnote)
Set oFootnote = oDoc.Footnotes
With oFootnote
Selection.Range.Words.Last.Words (2)
'Make the last two words bold'
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Font.bold = True
End With
End With
Selection.Find.Execute
'Set oFootnote = Nothing
Next
I tried
Set oFootnote = oDoc.Footnotes Range:=Selection.Words.Last.Words(2)
but it doesn't like "Range:= onwards" so I did
Selection.Range.Words.Last.Words (2) invalid use of a property
There is usually more than one way to achieve something like this, but the key is usually to work with a dedicated Range object.
In the code below, that bases on the code in the question, the Range object is assigned to each individual Footnote object in a loop of the Footnotes. It is then collapsed to its end-point and the start extended backwards by two words. (To better understand how this works, think of selecting the footnote, pressing right-arrow, then pressing ctrl+shift+left arrow twice to select the last two words.)
Dim oDoc As Document
Dim oFootnotes As Footnotes
Dim Ftnote As Footnote
Dim rngFootnote As Word.Range
'Document is the ActiveDocument
Set oDoc = Application.ActiveDocument
'the author's name needs to be bold (the last two words in each footnote)
Set oFootnotes = oDoc.Footnotes
For Each Ftnote In oFootnotes
Set rngFootnote = Ftnote.Range
rngFootnote.Collapse wdCollapseEnd
rngFootnote.MoveStart wdWord, -2
rngFootnote.Font.Bold = True
Next
Note that the reason for one of the errors in the question is because Words.Last returns a Range object containing the last word. Since it contains only one word - the last - Words(2) can't find anything it can work with.
The reason for the other error is that it's not possible to assign a Range to a Footnote or Footnotes object. They're different things, entirely...
Not super familiar with word objects, but try this. Worked for my couple of tests.
Basically it loops through all foot notes. And uses the index of the word to set that word's bold property to true.
Sub Test()
Dim oFootNote As Footnote
Dim oLastIndex As Long
For Each oFootNote In ActiveDocument.Footnotes
oLastIndex = oFootNote.Range.Words.Count
If oLastIndex > 2 Then
oFootNote.Range.Words(oLastIndex).Bold = True
oFootNote.Range.Words(oLastIndex - 1).Bold = True
End If
Next
End Sub
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
I am hoping to use a macro to replace the endnotes in a word document. Here is my situtation:
I have two word docs. Both documents have the exact same number of endnotes. One document is full of the correct body content, but has placeholders for the end notes. The other document has outdated content, but has the correct endnotes to to fill the placeholders in the first document.
I have setup a macro below that can loop through all of the endnotes in the correct file, and then opens the other document called "old.docx" below. I just dont know how to go about replacing the endnotes in old.docx with the value of ftstr (please see below).
Any help would be great!
Sub endnoteReplacer()
Dim ft As Endnote
Dim wrdApp As Object
Dim wrdDoc As Object
Dim r1 As Range, ftstr As String, mark
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = False
Set wrdDoc = wrdApp.Documents.Open("C:\Desktop\old.docx")
For Each ft In Word.ActiveDocument.Endnotes
ftstr = ft.Range.Text
wrdDoc.Endnotes(ft.Index).Range.Text = ftstr
Next ft
End Sub
If I get you right you need this simple solution to add within your loop:
For Each ft In Word.ActiveDocument.Endnotes
ftstr = ft.Range.Text
'change value of corresponding footnote in old.docx to value of ftstr
'!! new line !!
wrdDoc.Endnotes(ft.Index).Range.Text = ftstr
Next ft
But I assumed that you need to change endnotes(1) to endnotes(1), 2 to 2, etc...
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