I am trying to convert the footnotes into a specific font style (Chicago Style). I have managed to change font of footnotes separately but I can't refer to the footnote reference number in the footnotes of the pages. I am trying to convert the superscript into a normal number and can't get the code to work for some reason. It keeps changing the superscripts in the rest of the body of the document which is not what I am looking for because reference number in body are kept superscripted. Any help would be appreciated. Thank you!
With ActiveDocument.Styles("Normal").Font
.Name = "Palatino Linotype"
.Size = 11
End With
Dim afn As Footnote
For Each afn In ActiveDocument.Footnotes
With afn.Range
.Font.Size = 8.5
.Font.Name = "Palatino Linotype"
.Text = .Text
End With
Next afn
Dim f As Footnote
For Each f In ActiveDocument.Footnotes
With f.Range.Characters(1)
.Font.Superscript = False
End With
Next
'With Selection
'.Paragraphs(1).Range.Font.Reset
'.Paragraphs(1).Range.Characters(2) = ""
'.InsertAfter "." & vbTab
'.Collapse wdCollapseEnd
'End With
'For Each afn In ActiveDocument.Footnotes
'With ActiveDocument.Content.Find
'.ClearFormatting
'.Replacement.ClearFormatting
'.Font.Superscript = True
'.Format = True
'.Text = ""
'.Replacement.Text = "^&"
'.Replacement.Font.Superscript = False
'.MatchWildcards = True
'.Execute Replace:=wdReplaceAll
'End With
'Next afn
'Make Footnotes non-superscripted
'With ActiveDocument.Content.Find
'.ClearFormatting
'.Replacement.ClearFormatting
'.Font.Superscript = True
'.Format = True
'.Text = ""
'.Replacement.Text = "^&"
' .Replacement.Font.Superscript = False
' .MatchWildcards = True
' .Execute
A Word document is constructed from a number of Story Ranges, one of which is the Footnotes Story.
To make the footnote number non-superscript just in the footnotes you can execute a find and replace in the Footnotes Story as below.
Sub ApplyChicagoStyle()
With ActiveDocument.StoryRanges(wdFootnotesStory).Find
.Style = ActiveDocument.Styles(wdStyleFootnoteReference)
.Replacement.Style = ActiveDocument.Styles(wdStyleFootnoteText)
.Replacement.Font.Superscript = False
.Format = True
.Execute Replace:=wdReplaceAll
End With
End Sub
You would need to run this after you have added all the footnotes to your document.
Your post is ambiguous:
• Are you trying to modify the footnotes, or the footnote references?
• Does Chicago actually require a specific font for footnotes, or a different font for the footnote reference in the footer from the footnote reference in the document body? I cannot find any documentation that suggests that either proposition is the case.
If it's the footnotes you want to change, change the Footnote Style. No code required.
Alternatively, if you want to remove the superscripting from the footnote references in the footnotes, but not in the document body, you could use a Find/Replace there. As a macro, this would be:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.StoryRanges(wdFootnotesStory).Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^2"
.Replacement.Text = "^&"
.Replacement.Font.Superscript = False
.Forward = True
.Format = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub
Related
I am creating an automated document generation tool using data from an Excel workbook through VBA code.
The code below replaces text and inserts the images, however, they get pushed into the top of the document.
Is there any way to return the position of the found text, declare a range based on the position, and use that to insert the inline-shape (image) into the line after the tagName text?
I had this working previously through calling Word macros from Excel, however, this needs to be completely Excel based.
This program will be handling Word documents that have no VBA.
For Each sr2 In wDoc.StoryRanges
With sr2.Find
.Text = tagName
.Replacement.Text = tagValue
.Wrap = 1
.Execute Replace:=2
If .Found = True Then
sr2.InlineShapes.AddPicture fileName:=ThisWorkbook.Path & "\1. SOW Templates\ Client Summary import.jpg"
End If
End With
Next sr2
To easily loop through the results of the Find method, it would be easier if you are using Replace:=wdReplaceOne (wdReplaceOne=1) instead of Replace:=wdReplaceAll (wdReplaceAll=2). (Based on this this answer).
To insert the image, I would suggest you to select the range you want the image to be. Add it as a free floating image and then convert it to an inline shape.
Here's a way to do this:
Dim r As Object 'Word.Range
Dim bFound As Boolean
bFound = True
Set r = wDoc.Content
r.Find.ClearFormatting
Do While bFound
With r.Find
.Text = tagname
.Replacement.Text = tagValue
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
bFound = .Execute(Replace:=wdReplaceOne)
End With
If bFound Then
r.Select
Selection.Next(Unit:=wdParagraph, Count:=1).Select
Dim img As Object 'Word.Shape
Set img = wDoc.Shapes.AddPicture(Filename:=ThisWorkbook.Path & "\1. SOW Templates\ Client Summary import.jpg")
img.ConvertToInlineShape
End If
Loop
Would you please help me to select the whole paragraph beneath a given heading in a word file and import its content to an excel file through VBA?
The heading is always named 'Notes' in the word file and is the heading 4 when I use the Go to command to reach it.
I tried to use the content.find property with the word.application object but it copies the entire document.
I also tried to reach the requested title with the GoTo method with the following paraeters: what:=wdGoToHeading, which:=wdGoToAbsolute, Count:=4, but it is not accepted by the method and outputs an error message when compiled.
Sub ImportWordTables()
'Imports a table from Word document
Dim applWord As Object
Dim notes As String
Dim wdDoc As Object
Dim wdDocName As String
Dim wdFileName As Variant
...
Set applWord = CreateObject("Word.Application")
applWord.Visible = True
applWord.WindowState = 1
wdFileName = Application.GetOpenFilename("Word files (*.doc*),*.doc*", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Application.Goto (ActiveWorkbook.Sheets("Sheet1").Range("A1"))
Set wdDoc = applWord.Documents.Open(wdFileName)
I tried:
applWord.ActiveDocument.Range.Selection.Goto what:=wdGoToHeading, which:=wdGoToAbsolute, Count:=4
And:
With applWord.ActiveDocument.Content.Find
.ClearFormatting
.Text = "Notes"
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
With .Parent
.Select
.Copy
End With
applWord.ActiveDocument.Range.Selection.Copy
Thanks a lot for your help and have a nice day !
You're on the right track with Content.Find...
When you use Find, remember to also use .Execute, otherwise, nothing will happen. It's like clicking the OK button in a dialog box, after setting the properties.
Generally, it's better to use a dedicated Range object with Find that can be manipulated. When Find is run, the range or selection on which it is executed will change to the "found" content. So Selection.Find would have worked for you (as long as you execute). But ActiveDocument.Content cannot because it can't change. That's why a dedicated Range object is needed.
Extending the found content: Word has a number of Move methods for ranges and selections. For this, I'd use MoveEnd (for details see the language reference).
The following code snippet, based on code in the question, illustrates these points.
Dim rngFind As Object
Set wdDoc = applWord.Documents.Open(wdFileName)
Set rngFind = wdDoc.content
With rngFind.Find
.ClearFormatting
.Text = "Notes"
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
If .Execute Then
rngFind.MoveEnd wdParagraph, 2
rngFind.Copy
End If
End With
Thanks again for your help.
I achieved to get something into the clipboard with the following:
Dim applWord As Object
Dim rngFind As Word.Range
Set rngFind = ActiveDocument.Content
With rngFind.Find
.ClearFormatting
.Text = "Notes"
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
rngFind.MoveEnd wdParagraph, 2
rngFind.Select
rngFind.Copy
There are many code lines next to this to change the layout, add some formulas, etc., but I do not put them for clarity purpose.
So, it works !
Next difficulty is with
rngFind.MoveEnd wdParagraph, 2
In fact, the content of the 'Notes' heading in my word file is a numbering list, so it is like:
Notes
1) first point
2) ...
3) ...
4) ...
With an undefined number of elements.
Is there a command I can use to be sure to catch the whole paragraph?
Yesterday, I tried to find a VBA command which would allow to collapse the heading, before copying it. The equivalent of right clicking next to it, 'Expand/collapse', then 'collapse heading'. I did not find anything like this, and I am not sure it is the best way to achieve what I would like.
So, if you still have bit of time to advise me, you would be warmly welcome :-)
Thanks and have a nice day !
I am using VBA codeI picked up online to essentially input a couple of sections and have Excel then edit a Word template, replacing <oaccount> for the inputted account number and <date> for the date of something, etc.
The issue I am facing is that when using it, the core value of the cell is being inputted and not what you see... For example, I have everything working except the date and the $ amount because when it replaces <date> and <amount> they show up as "240419" and "3450" when inputting 24/04/2019 and $3,460.00 respectively.
I want to find out how to get Excel to replace the key words with the actual displayed value of Excel.
Below is what I am using to do this:
Option Explicit
Public Sub WordFindAndReplace()
Dim ws As Worksheet, msWord As Object
Set ws = ActiveSheet
Set msWord = CreateObject("Word.Application")
With msWord
.Visible = True
.Documents.Open "F:\Test folder\TestFolder\Test.docx"
.Activate
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "CName"
.Replacement.Text = ws.Range("C1525").Value2
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
.Quit SaveChanges:=True
End With
End Sub
Have you tried using the Format function on the replacement line? There's a page with a description of it here. You can also try converting it to a string in that same line using the CStr() function.
It would look something like this if you use format:
.Replacement.Text = Format(ws.Range("C1525").Value2,"dd/mm/yyyy")
If you use the string conversion it would look like this:
.Replacement.Text = CStr(ws.Range("C1525").Value2)
I would like to highlight specific words given in a specific column of an excel sheet in a word document.
I have a working solution (see below) that reads the words from a word file but I can not get it running to do the same thing using a specific column from an excel file. Essentially I want to do what the following python code does (but for VBA):
import pandas as pd
all = pd.read_excel("list.xlsx")
docRef = all(all["MY COLUMN NAME"])
... and the docRef should be used in the code below. I just cant get it running ...
Sub highlightWords()
Dim sCheckDoc As String
Dim docRef As Document
Dim docCurrent As Document
Dim wrdRef As Object
sCheckDoc = "list.docx"
Set docCurrent = Selection.Document
Set docRef = Documents.Open(sCheckDoc)
docCurrent.Activate
Options.DefaultHighlightColorIndex = wdRed
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = True
.Replacement.Text = "^&"
.Forward = True
.Format = True
.MatchWholeWord = True
.MatchCase = False
.MatchWildcards = False
End With
For Each wrdRef In docRef.Words
If Asc(Left(wrdRef, 1)) > 32 Then
With Selection.Find
.Wrap = wdFindContinue
.Text = wrdRef
.Execute Replace:=wdReplaceAll
End With
End If
Next wrdRef
docRef.Close
docCurrent.Activate
End Sub
Code modified from here.
In order to control Excel from within Word you should set a reference to the Excel library in the Word VBA editor : Tools, References, scroll down to Microsoft Excel and tick it.
Then you need to open Excel, and load the workbook
Dim XL as new Excel.Application
Dim wb as Excel.Workbook
Set wb = xl.Workbooks.open("path and name of file list.xlsx")
For Each wordref in wb.Sheets(1).Range("a1:A" & wb.Sheets(1).usedrange.rows.count)
I am trying to write a Word macro which takes data from an Excel Cell and replaces a words in a Word file with this taken data.
My first problem was to replace more than 250 chars, which I fixed.
But this resulted in a new problem.
The data in the Excel file is formatted and this formatting gets destroyed once I replace the word in the Word document.
My replace function looks like this:
Sub ReplaceText(strSearch As String, strReplace As String)
Dim sSplit As String: sSplit = "<Å*Å>"
Dim sLeft As String
Dim sLarge As Boolean: sLarge = True
Do While sLarge = True
If Len(strReplace) > 251 Then
sLeft = Left(strReplace, 250) & sSplit
strReplace = Right(strReplace, Len(strReplace) - 250)
Call Split_Replace(strSearch, sLeft)
ElseIf Len(strReplace) <= 251 Then
Call Split_Replace(strSearch, strReplace)
sLarge = False
End If
strSearch = sSplit
Loop
End Sub
Sub Split_Replace(strSearch As String, strReplace As String)
With Selection.Find
.Text = strSearch
.Replacement.Text = strReplace
.Forward = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
End Sub
And I call it this way:
Call ReplaceText("intro", MyWB.Sheets(Geschlecht).Cells(7, 4)
But everything like (bold, italic, underline, numbering, etc.) gets removed.
If I use a MsgBox to show me the data he got from the excel cell, it is formated in the right was:
for example in the Replace Function
MsgBox strReplace
Shows the right formatting.
I hope one of you guys know how to fix this or could give me a tip in the right direction.
Greetings Lars