Remove extra line after adding/deleting a bookmark in VBA - vba

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

Related

Macro for Adding Text To Begining of Every Paragraph

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.

Select and format pasted article in word

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

Check if a Range of text fits onto a single line

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

Word.Range.TextVisibleOnScreen?

Does the Word.Range.TextVisibleOnScreen property actually work?
Private Sub isVisTest()
Dim rng As Range: Set rng = oDoc.Bookmarks("_Toc#########").Range
'replace ######### with a good Heading bookmark number from your test document
Dim c As Integer
ActiveWindow.VerticalPercentScrolled = 0
ActiveWindow.HorizontalPercentScrolled = 0
oDoc.ActiveWindow.ScrollIntoView rng
Do
oDoc.ActiveWindow.SmallScroll Down:=6
Debug.Print rng.TextVisibleOnScreen
c = c + 1
If c > 10 Then Exit Do
Loop Until rng.TextVisibleOnScreen = 0
oDoc.ActiveWindow.SmallScroll Up:=6
End Sub
The abbreviated procedure uses Heading bookmark to display the corresponding Heading at the top of the screen simto Word's built-in Nav Pane behavior. The Do-Loop is a refinement to bring the Heading to top of page but I'm finding that the rng.TextVisibleOnScreen property never changes regardless of whether the rng object is actually visible onscreen or not; it's always -1. Thus the property seems disabled. However, MSDN doesn't report it as being disabled or deprecated.
The same test can be done by using a Selection and the IDE's Immediate window, i.e., ?Selection.Range.TextVisibleOnScreen. I get the same result; always -1.
As implied by the language reference
The TextVisibleOnScreen property returns 1 if all text in the range is
visible; it returns 0 if no text in the range is visible; and it
returns -1 if some text in the range is visible and some is not. Text
that is not visible could be, for example, text that is in a collapsed
heading.
this property lets you know whether a Range is visible or not due to a Heading style being collapsed or expanded. The capability to collapse/expand sections of text under a heading was introduced at the same time - in Word 2013.
It has nothing to do whether text is hidden or scrolled off the screen.
What is definitely odd / misleading is the statement that 1 is returned when something is visible and -1 when something is only partially visible. I believe this is a mistake in the documentation, possibly from the 2013 beta that never was corrected.
The following code returns 0 when the range (second paragraph in the document) is not visible because a heading style before it is collapsed:
Sub TestHiddenText
Dim rng as Word.Range
Set rng = ActiveDocument.Paragraphs(3).Range
Debug.Print rng.TextVisibleOnScreen
End Sub
When the heading is expanded, the above returns -1 (which traditionally has always been "true" in Word).
If I collapse that heading, but test the entire document, the mixed status returns what I'd expect from Word - undefined: 9999999
Sub TestHiddenText
Dim rng as Word.Range
Set rng = ActiveDocument.Content
Debug.Print rng.TextVisibleOnScreen
End Sub

Excel VBA to insert comments on selected cells and filled them with pictures

I have a list of more than 150 cells which contained hyperlinks to images on local hard,
yesterday I found a way to popup those images by inserting comments with filling the background with a picture.
It will be tough to do this one by one, So I want a VBA script to insert comments on selected cells and fill the comments background with images which its hyperlink located in every cell.
Is That possible or should I do it manually?
Here is an Example of cells contents
I1 D:\My Pictures\example 001.jpg
I2 D:\My Pictures\example 021.jpg
I3 D:\My Pictures\example 030.jpg
Recording a macro shows that the above is possible. A little tweaking is in order, though. As an example, the following macro creates an image pop-up via comment for A1.
Sub Test()
Dim Comm As Comment
On Error Resume Next
Range("A1").AddComment
Range("A1").Comment.Visible = False
Set Comm = Range("A1").Comment
Comm.Shape.Fill.UserTextured "C:\foo\bar.gif"
End Sub
The On Error Resume Next is for handling ranges that already have comments, so you can keep on running the macro repeatedly. I set .Visible to False to be safe that the images don't become permanent pop-ups (should only appear on hover).
We can tweak the above further to create a subroutine that takes in a range and a string as arguments so we can call it repeatedly across ranges.
Sub CreatePopUp(TargetRange As Range, PathToImage As String)
Dim Comm As Comment
On Error Resume Next
With TargetRange
.AddComment
.Comment.Visible = False
Set Comm = .Comment
End With
Comm.Shape.Fill.UserTextured PathToImage
End Sub
The above can be called like so:
Sub MassPopUp()
Dim rCell As Range
For Each rCell In [A1:A10]
CreatePopUp rCell, "Blah"
Next
End Sub
Let us know if this helps.
EDIT:
If your date is in, for example, I1:I10, and they contain the exact paths to the image files, then the above can be written like so:
Sub MassPopUp()
Dim rCell As Range
For Each rCell In [I1:I10]
CreatePopUp rCell, rCell.Value
Next
End Sub
rCell.Value will take the value inside the cell, pass it to the subroutine that inserts an image, and apply it as a comment to rCell with the proper image extracted. This should not fail. Just make sure the value in the cell are proper paths to their respective files.