I have many occasions that I have to copy article from web-page, paste to word and format in a certain way. I had this code to auto paste and format. However, it only work once, and it just doesn't change the font of the pasted article later on.
Sub Macro1()
Dim artic As Word.Range
Set artic = Selection.Range
'keep bold word bold and avoid paragraphs to cluster into one
artic.PasteAndFormat (wdFormatOriginalFormatting)
'paste and select pasted article
artic.Select
artic.Font.Name = "Calibri"
artic.Font.Size = 10.5
artic.Font.Italic = False
artic.ParagraphFormat.Alignment = wdAlignParagraphLeft
End Sub
If you set a breakpoint at artic.Font.Name = "Calibri" so that the code stops after artic.Select you'll see that the Paste method does not include what's been pasted. Generally, artic will be at the beginning of the pasted content.
This means the code needs to be able to locate the position just after where the Selection was before pasting. It also depends on whether the paste occurs at the end of the document, or not.
The following sample code worked for me in my tests. It uses two Ranges: one for where the content will be pasted, the other for the end position after pasting.
(Responding to request for more clarification about the Word object model): Think of a Range object like a selection, with the difference that there can be many Range objects, but only one Selection. When manipulating a Range it often helps to think of using the keyboard to reduce or expand it. Pressing the left- or right-arrow keys will "collapse" a selection to an insertion point; holding Shift and pressing these keys will expand/reduce a selection; holding Shift while clicking somewhere else in the document will also do that. Think of setting Range.Start or Range.End as the equivalent of this last. The start or end point of the Range is being arbitrarily set to another location in the document.
In the case of the first If in the code below the Range is being reduced/collapsed to its starting point (think left-arrow key), then moved one character to the right (think right-arrow key). This puts it beyond where new material will be pasted, so extending the paste point's end to this Range's starting point will pick up everything between the two.
Sub TestPasteAndSelect()
Dim artic As Word.Range, rng As Word.Range
Dim bNotAtEnd As Boolean
Set artic = Selection.Range
Set rng = artic.Duplicate
rng.End = ActiveDocument.content.End
If rng.Characters.Count > 1 Then
'selection is not at end of document
rng.Collapse wdCollapseStart
rng.MoveStart wdCharacter, 1
bNotAtEnd = True
End If
'keep bold word bold and avoid paragraphs to cluster into one
artic.PasteAndFormat (wdFormatOriginalFormatting)
'paste and select pasted article
'artic.Select
'rng.Select
If bNotAtEnd Then
artic.End = rng.Start
Else
Set artic = rng.Duplicate
End If
artic.Font.Name = "Calibri"
artic.Font.Size = 10.5
artic.Font.Italic = False
artic.ParagraphFormat.Alignment = wdAlignParagraphLeft
End Sub
Related
In My Word Template I have few bullet points, and I will select the required points based on selection from the GUI and remove the rest of the points that are not selected from the code. So it depends on the user how many points that he would select.
I am Tall (bookmark1)
I am Dark (bookmark2)
I am 6.2 feet height (bookmark3)
I Have BMW (bookmark4)
I know 5 different languages (bookmark5)
I have created bookmarks for all these points as shown in the braces above.
Now the problem is, the user selects few number of bullet points from the above list and output would leave an extra blank line below.
I have tried many approaches from changing the selection of the bookmarks to adding bullet point form the code. I need to get rid of the extra blank line.
But nothing seems to work. I would appreciate the help in this. TIA
If .cboChanges1.Value = "No" Then
DeleteBookmark ("bookmark1")
Else
AddBullet ("bookmark1")
End If
If .cboChanges2.Value = "No" Then
DeleteBookmark ("bookmark2")
Else
AddBullet("bookmark2")
End If
etc.. where cboChanges1 and cboChanges2 are combo boxes to choose Yes/no.
Sub DeleteBookmark(strBookmark As String)
Dim rng As Range
Set rng = ActiveDocument.Bookmarks(strBookmark).Range
rng.Delete
Set rng = Nothing
End Sub
Before Screenshot
Output screen after first 3 options, you can see extra blank line as highlighted
I am adding the bullet point dynamically, as follows
Sub AddBullet(strBookmark As String)
ActiveDocument.Bookmarks(strBookmark).Select
Selection.Range.ListFormat.ApplyBulletDefault
End Sub
This is how the bookmarks are arranged,
A table cell always contains an end of cell marker which is a combination of paragraph and end of cell mark. This means that an empty cell always contains at least one paragraph.
As the end of cell marker cannot be deleted when you delete the text in the last bookmark you will get an empty paragraph because the previous bookmarked range ends with a paragraph mark.
You can deal with this in your DeleteBookmark routine by checking the length of the final paragraph of the cell. If it only contains two characters then it has no text and the preceding paragraph mark can be deleted.
Sub DeleteBookmark(strBookmark As String)
Dim rng As Range
Set rng = ActiveDocument.Bookmarks(strBookmark).Range
rng.Delete
Set rng = rng.Cells(1).Range.Paragraphs.Last.Range
If Len(rng.Text) = 2 Then
'paragraph contains no text so delete preceding paragraph mark
rng.Collapse wdCollapseStart
rng.MoveStart wdCharacter, -1
rng.Delete
End If
Set rng = Nothing
End Sub
If you are going to write code for Word you need to learn what the formatting marks are so that you can understand how a document is constructed.
FYI It is not necessary to select a range to apply bullets.
Sub AddBullet(strBookmark As String)
ActiveDocument.Bookmarks(strBookmark).Range.ListFormat.ApplyBulletDefault
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 am trying to create a Word macro that will go through a large document that I have and add the text "SAMPLE" to the beginning of every paragraph.
The document contains a Title page, Table of Contents and Headings throughout and I would prefer none of these have the "SAMPLE" text on them, just the paragraphs.
Below is some macro code I have found on various sites and kind of pieced together to do somewhat of what I want. It does place the "SAMPLE" text at the beginning of some paragraphs but not all, usually only the first paragraph of a new section within my document. And it also places it at the end of the Table of Contents and Beginning of the Title page.
I am brand new to macros in Word so any help is appreciated or if there is a better way of doing this perhaps? There might even be some unnecessary bits in this code since it is pieced together from other samples.
Sub SAMPLE()
Application.ScreenUpdating = False
Dim Par As Paragraph, Rng As Range
For Each Par In ActiveDocument.Paragraphs
If Par.Style = "Normal" Then
If Rng Is Nothing Then
Set Rng = Par.Range
Else
Rng.End = Par.Range.End
End If
Else
Call RngFmt(Rng)
End If
If Par.Range.End = ActiveDocument.Range.End Then
Call RngFmt(Rng)
End If
Next
Application.ScreenUpdating = True
End Sub
Sub RngFmt(Rng As Range)
If Not Rng Is Nothing Then
With Rng
.End = .End - 1
.InsertBefore "SAMPLE"
End With
Set Rng = Nothing
End If
End Sub
Provided your Title, Table of Contents and Headings etc. don't use the Normal Style - as they shouldn't - you really don't need a macro for this - all you need is a wildcard Find/Replace where:
Find = [!^13]*^13
Replace = SAMPLE: ^&
and you specify the Normal Style as a Find formatting parameter. You could, of course, record the above as a macro, but that seems overkill unless you're doing this often.
I have a macro that converts track changes to either underline or strikethrough and it does it on the entire word document. However, I would like it to run only on track changes only within a section of the document found between a first tag and a second tag (let's say between the words "Beginning" and "Ending"). I do not want this macro to make changes anywhere other than between these two tags. In other words, if I run this macro, only track changes within these two tags should be modified based on the macro and the rest of the document should keep its track changes intact.
Please let me know if you can help me modify this macro based on the above requirement.
Here's what I have but it runs on the entire document.
Sub FormatRevisions()
Dim rev As Revision, txt As String, r As Long, ran As Range
'First switch off TrackChanges, else each of your reformattings will become a revision again
ActiveDocument.TrackRevisions = False
'***Now cycle through revisions, identify type of change
For Each rev In ActiveDocument.Revisions
Select Case rev.Type
Case wdRevisionDelete
'secure "deleted" text as well as its position
txt = rev.Range.Text
r = rev.Range.Start
'accept the revision to make the markup disappear
rev.Accept
'now type the text formatted as strikethrough at the position of the old text
Set ran = ActiveDocument.Range(r, r)
With ran
.Text = txt
.Font.StrikeThrough = 1
End With
Case wdRevisionInsert
Set ran = rev.Range
'accept the revision to make the markup disappear
rev.Accept
'now type the text formatted as underlined at the position of the old text
ran.Font.Underline = 1
End Select
Next rev
End Sub
Try:
Sub FormatRevisions()
Application.ScreenUpdating = False
Dim Rvn As Revision, Rng As Range
'First switch off TrackChanges, else each of your reformattings will become a revision again
ActiveDocument.TrackRevisions = False
With ActiveDocument.Range
'Find the defined range
With .Find
.Text = "Beginning*Ending"
.MatchWildcards = True
.Execute
End With
If .Find.Found = True Then
'***Now cycle through revisions, identify type of change
For Each Rvn In .Revisions
With Rvn
Select Case .Type
Case wdRevisionDelete
Set Rng = .Range
'Reject the revision to make the markup disappear
.Reject
'now format the text as strikethrough
Rng.Font.StrikeThrough = True
Case wdRevisionInsert
Set Rng = .Range
'Accept the revision to make the markup disappear
.Accept
'now format the text as underlined
Rng.Font.Underline = wdUnderlineSingle
End Select
End With
Next
End If
End With
Application.ScreenUpdating = True
End Sub
The above approach also has the advantage of retaining the formatting of the deleted and added text.
I'm programmatically filling in a regulated form template where lines are predefined (as table cells):
(Using plain text Content Controls as placeholders but this isn't relevant to the current question.)
So, I have to break long text into lines manually (auto-adding rows or something is not an option because page breaks are also predefined).
Now, since characters have different width, I cannot just set some hardcoded character limit to break at (or rather, I can, and that's what I'm doing now, but this has proven to be inefficient and unreliable, as expected). So:
How do I check if a Range of text fits on a single line -- and if it doesn't, how much of it fits?
I've checked out Range Members (Word) but can't see anything relevant.
The only way is to .Select that text, them manipulate the selection. Selection in the only object for which you can use wdLine as a boundary. Nothing else in the Word object model works with automatic line breaks.
Sub GetFirstLineOfRange(RangeToCheck As Range, FirstLineRange As Range)
'Otherwise, Word doesn't always insert automatic line breaks
'and all the text will programmatically look like it's on a single line
If Not Application.Visible Or Not Application.ScreenUpdating Then
Application.ScreenRefresh
End If
Dim SelectionRange As Range
Set SelectionRange = Selection.Range
Set FirstLineRange = RangeToCheck
FirstLineRange.Select
Selection.Collapse Direction:=wdCollapseStart
Selection.EndOf Unit:=wdLine, Extend:=wdExtend
Set FirstLineRange = Selection.Range
If FirstLineRange.End > RangeToCheck.End Then
FirstLineRange.End = RangeToCheck.End
End If
SelectionRange.Select
End Sub
Function IsRangeOnOneLine(RangeToCheck As Range) As Boolean
Dim FirstLineRange As Range
GetFirstLineOfRange RangeToCheck, FirstLineRange
IsRangeOnOneLine = FirstLineRange.End >= RangeToCheck.End
End Function
The subroutine GetFirstLineOfRange takes a RangeToCheck and sets FirstLineRange to the first text line in the given range.
The function IsRangeOnOneLine takes a RangeToCheck and returns True if the range fits on one line of text, and False otherwise. The function works by getting the first text line in the given range and checking whether it contains the range or not.
The manipulation of the Selection in GetFirstLineOfRange is necessary because the subroutine wants to move the end of the range to the end of the line, and the movement unit wdLine is available only with Selection. The subroutine saves and restores the current Selection; if this is not necessary then the temporary variable SelectionRange and the associated statements can be deleted.
Note:
There is no need to scroll anything - which in any event is not reliable. Try something based on:
With Selection
If .Characters.First.Information(wdVerticalPositionRelativeToPage) = _
.Characters.Last.Information(wdVerticalPositionRelativeToPage) Then
MsgBox .Text & vbCr & vbCr & "Spans one line or less."
Else
MsgBox .Text & vbCr & vbCr & "Spans more than one line."
End If
End With