A vba script that seems simple but don't work exactly as I want .
My script inserts images ( PNG files) in the current document with a caption after each picture that is the name of the file.
So to insert images I use:
Selection.InlineShapes.AddPicture FileName: = sFile
Selection.TypeParagraph
And to insert text after I use:
Set Opar = ActiveDocument.Paragraphs.Add
oPar.Range.Text = sFile
oPar.Range.Style = " Normal"
The problem is that images are all found in the beginning of the document , arranged in reverse order (the last image inserted appears first in the document) and legends are all found at the end of the document.
What's happening ?
#Boro: It's more efficient to work directly with the object model than trying to coerce Selection (imitating the user actions). There's no single way to achieve what you describe, so I'm going to demonstrate my preference:
Dim ils as Word.InlineShape
Dim rng as Word.Range
'Starting with current sel, but this could also be a Range...
Set ils = Selection.InlineShapes.AddPicture(FileName: = sFile)
Set rng = ils.Range
'Move the focus AFTER the picture
rng.Collapse wdCollapseEnd
'new para, text, followed by new para
rng.Text = vbCr & sFile & vbCr
rng.Style = wdStyleNormal
'focus in last para inserted by code
rng.Collapse wdCollapseEnd
'Do other things with the Range...
'Leave cursor there for user to work
rng.Select
The key in my approach is collapsing the Range, either to the start or end point. Think of it like pressing the left or right arrow key to reduce the selection to a blinking cursor. Except you can have any number of Ranges (but only one Selection) and things won't jump around on the screen.
Related
Within a Word docx: I'm trying to add a bookmark to each sentence. For example, at first sentence would be bookmark "bmarkpg01" and second sentence would be bookmark ""bmarkpg01ln01col01"". My code adds only one bookmark to first sentence and doesn't loop through to end of document.
I've tried a for each loop to attempt each sent in sentences and each bmark in bookmark.
Sub tryAddBmarkatSentence()
Dim myRange As Range
Set myRange = ActiveDocument.Content
Dim bmark As Bookmark
Application.ScreenUpdating = False
For Each MySent In ActiveDocument.Sentences
For Each bmark In ActiveDocument.Bookmarks
ActiveDocument.Bookmarks.Add Name:="pmark" & bmark.Range.Information(wdActiveEndAdjustedPageNumber), Range:=myRange 'bmark name would have added info of page, line, and col number. here as example is pagenumber.
Next
Next
End Sub
EXPECTED RESULT: Within entire document, each sentence has a corresponding bookmark and bookmark name ("bmarkpg01ln01col01", "bmarkpg01ln02col10", etc.)
ACTUAL RESULTS: only one bookmark is added to the first sentence of the document.
The following works for me, as far as the requirements in the question go.
Please remember to put Option Explicit at the top of a code page. This will force you to declare ("Dim") variables, but will also save time and trouble as it will prevent typos and warn you of other problems.
A Sentence in Word returns a Range object, so the code below delares MySent As Range. This provides the target Range for the Bookmarks.Add method.
If you won't be doing anything else with the bookmark, it's not strictly necessary to Set bkm = when adding the bookmark. I left it in since it is declared in the code in the question.
It's not necessary to loop the collection of bookmarks - espeicially since there aren't any - they're being added.
I've added some code for naming the bookmarks, as well.
Sub tryAddBmarkatSentence()
Dim doc As Word.Document
Dim MySent As Word.Range
Dim bmark As Bookmark
Application.ScreenUpdating = False
Set doc = ActiveDocument
For Each MySent In doc.Sentences
Set bmark = doc.Bookmarks.Add(Name:="bmark" & _
MySent.Information(wdActiveEndAdjustedPageNumber) & "_" &_
MySent.Information(wdFirstCharacterLineNumber) & "_" & _
MySent.Information(wdFirstCharacterColumnNumber), Range:=MySent)
'bmark name would have added info of page, line, and col number. here as example is pagenumber.
Next
End Sub
u can try like this
Sub tryAddBmarkatSentence()
Dim myRange As Range
Set myRange = ActiveDocument.Content
Dim bmark As Bookmark
Application.ScreenUpdating = False
For Each MySent In ActiveDocument.Sentences
ActiveDocument.Bookmarks.Add ... and the rest of the code.
//i dont know how you define witch bookmark is to asign to that sentence
Next
End Sub
I'm building an index via a macro, and after a little bit, the page numbers start to get wonky. At first, they are correct, but as we go deeper in the document, they start getting offset.
I have a hunch it's because the code I'm using uses a range (.Index.MarkEntry Range:=theRange ...), and the page of the end of the range is where the page number comes from.
How can I make sure that the page number the index uses, is the page that has the first character in the range (does that make sense? Whatever page the entry starts on, is the page I want to use).
Here's my (truncated for relevance) code:
Sub Find_Definitions()
Dim myDoc As Word.Document
Dim oRng As Word.Range, rng As Word.Range, rngXE As Word.Range, tempHold As Word.Range
Dim addDefinition$, findText$, editedDefinition$
Dim meanTypes() As Variant
Dim rngEdited
Dim y&
Dim bFound As Boolean
meanTypes = Array(Chr(150) & " means", Chr(151) & " means", "- means", Chr(150) & " meaning", Chr(151) & " meaning", "- meaning")
Set myDoc = ActiveDocument
bFound = True
Call Clear_Index
For y = LBound(meanTypes) To UBound(meanTypes)
'Loop through the document
Set oRng = myDoc.Content
Set rngXE = oRng.Duplicate
With oRng.Find
.ClearFormatting
.ClearAllFuzzyOptions
'.Text = findText
.Text = meanTypes(y)
.MatchCase = False
.Wrap = wdFindStop
End With 'orng.find
Do While bFound
bFound = oRng.Find.Execute
If bFound Then
Set rngXE = oRng.Paragraphs(1).Range.Duplicate
rngXE.Select
' Here's where I could check the text, and see if it starts with Roman numerals.
editedDefinition = Check_For_Roman_Numerals(rngXE, findText)
If editedDefinition <> "" Then 'If editedDefinition is empty, that means there's no definition to add to the index
Set rngEdited = rngXE.Duplicate
With rngEdited
.moveStart unit:=wdCharacter, Count:=x
.Select
‘ This next line is my idea that the range’s page number is being used, so I just wanted to print it to see.
Debug.Print rngEdited.Information(wdActiveEndPageNumber)
End With 'rngEdited
myDoc.Indexes.MarkEntry Range:=rngEdited, entry:=editedDefinition, entryautotext:=editedDefinition
End If ''editedDefinition <> ""
oRng.Collapse wdCollapseEnd
oRng.Start = oRng.Paragraphs(1).Range.End
oRng.End = myDoc.Content.End
rngEdited.Collapse wdCollapseEnd
rngEdited.End = myDoc.Content.End
' Set rngXE = Nothing
End If 'bFound
Loop
bFound = True
Next y
TheEnd:
Set rng = Nothing
myDoc.Indexes(1).Update
MsgBox ("Added all definitions.")
End Sub
I'm thinking what I'll need to do is to "tighten up" the editedRange, so it ends on the same page? But if a definition spans a page break, I want to use the smaller of the page numbers that it appears on (the first one).
Thanks for any ideas/tips/thoughts.
Generally, when the page numbers in an Index don't match with what you expect it's because the document is displaying content that won't be in the printed result. This affects the pagination on-screen, "pushing" content "down" in the document. Most often, the reason is field codes, which can be suppressed by pressing Alt+F9 until the field results display.
This approach does not work for XE (index markers) and some other field types, as well as hidden text, however. They display whenever the display of "Hidden" text is allowed. Depending on the settings in File/Options/Display/"Always show these formatting marks on the screen" clicking the "backwards P" button in the Ribbon's Home tab may or may not turn them off. If it does not, then you have to go into options to togge the display, or create a macro to do this and run it as required.
The other possible reason is that the programmatically generated XE field was inserted at the end of a long range of text that broke to another page, instead of being on the page where the text starts. In order to ensure the field is the start, rather than the end of a Range, collapse the Range to its starting point:
rngEdited.Collapse wdCollapseStart
I've been looking through the forums for a while now trying to find an answer to my problem, and either I'm dense or it hasn't been answered, so here I am.
Long story short, my job involves writing up word documents that list building deficits and provides hyperlinks to images of said deficits. The visible hyperlink text always follows the same format: '[site abbreviation][(image number)].JPG'. For example, if we are looking at 'Administrative Building', our images will be named 'AB(1).JPG', 'AB(2).JPG', etc, often into the mid-hundreds or thousands. In the word document, they are referenced as 'AB1', 'AB2' etc.
Currently, I have a macro that allows me to automatically create a hyperlink once I've selected the text, but I am trying to create a macro that will look through a document (or better yet, a highlighted selection) and assign hyperlinks to any text that starts with the site's abbreviation all at once.
My current attempt at a mass-hyperlinking macro is frustratingly close, but has one major error: while it will correctly hyperlink the first image name it finds, all subsequent images are linked with the next two characters included in the link. For example, if a sentence were to say "This is not correct (AB33), but this is correct (AB34)', my macro will hyperlink the text 'AB34' (which is correct) and 'AB33) ' (which is incorrect).
This is the macro I've been working with thus far (note that the text between the lines of 'XXXX...' are basic instructions for my coworkers to change the link destination as needed)
Option Explicit
Sub Mass_Hyperlink_v_1_1()
'incomplete: selects incorrect text after first link
Dim fileName As String
Dim filePath As String
Dim rng As Range
Dim tag As String
Dim FileType As String
Dim folder As String
Dim space As String
Dim start As String
Dim report_type As String
Dim temp As String
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Do not touch anything above this line
'Answer the following for the current document. Leave all quotations.
report_type = "CL" 'CL = Checklist
'SR = Site Report
folder = "Doors" 'The name of the folder you are linking images from
'Must match folder exactly
tag = "FS" 'Put file prefix here (ex. if link says "AB123", put "AB")
space = "No" 'Does the image file have a space in it? (ex. if file name is "AB (23)", put "yes")
FileType = ".JPG" 'make sure filetype extensions match
'Do not touch anything below this line
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
If space = "Yes" Then
start = "%20("
Else: start = "("
End If
If report_type = "CL" Then
folder = "..\Images\" & folder
Else: folder = folder
End If
If report_type = "SR" Then
folder = "Images\" & folder
Else: folder = folder
End If
Set rng = ActiveDocument.Range
With rng.find
.MatchWildcards = True
Do While .Execute(findText:=tag, Forward:=False) = True
rng.MoveStartUntil (tag)
rng.Select
Selection.Extend
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
'I believe the issue is created here
Selection.start = Selection.start + Len(tag)
ActiveDocument.Range(Selection.start - Len(tag), Selection.start).Delete
fileName = Selection.Text
filePath = folder & "\" & tag & start & fileName & ")" & FileType
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, address:= _
filePath, SubAddress:="", ScreenTip:="", TextToDisplay:= _
tag & Selection.Text
rng.Collapse wdCollapseStart
Loop
End With
End Sub
If I've explained this terribly wrong or not provided enough information, please let me know and I'll try to be more clear. And if there is a helpful resource that I'm simply too dense to have found, please let me know! thank you!
edit: if anyone knows how to only select words that start with the tag as opposed to words with the tag text in them, I'd be incredibly appreciative as well!
If you want to match a fixed tag followed by a variable number of digits:
Sub Tester()
TagMatches ActiveDocument, "AB"
End Sub
Sub TagMatches(doc As Document, tag As String)
Dim rng
Set rng = doc.Range
With rng.Find
.Text = tag & "[0-9]{1,}"
.Forward = True
.MatchWildcards = True
Do While .Execute
Debug.Print rng.Text
Loop
End With
End Sub
See: http://word.mvps.org/faqs/general/usingwildcards.htm
I have a script that looks for some text, inputted by the user. The idea is to look through a document for this text, and when it's found, select the paragraph and ask the user if they want to add this paragraph to an Index.
For some reason, I can't get the script to move past the first selected paragraph. When I run it, and click "Yes" in the UserForm (equivalent of myForm.Tag = 2), it adds to the index, but then when the .Find looks for the next instance of the text, it selects the paragraph I just had highlighted. ...it doesn't continue.
Here's the code:
Sub find_Definitions()
Dim defText As String, findText$
Dim oRng As Word.Range, rng As Word.Range
Dim myForm As frmAddDefinition
Set myForm = New frmAddDefinition
Dim addDefinition$, expandParagraph&
' expandParagraph = 1
Set oRng = ActiveDocument.Range
findText = InputBox("What text would you like to search for?")
With oRng.Find
.Text = findText
While .Execute
Set rng = oRng.Paragraphs(1).Range
rng.Select
defText = oRng.Paragraphs(1).Range
myForm.Show
Select Case myForm.Tag
Case 0 ' Expand the paragraph selection
Do While CLng(expandParagraph) < 1
expandParagraph = InputBox("How many paragraphs to extend selection?")
If expandParagraph = 0 Then Exit Do
Loop
rng.MoveEnd unit:=wdParagraph, Count:=expandParagraph
rng.Select
defText = rng
ActiveDocument.Indexes.MarkEntry Range:=rng, entry:=defText, entryautotext:=defText
Case 1 ' No, do not add to the index
' do nothing
Case 2 ' Yes, add to index
ActiveDocument.Indexes.MarkEntry Range:=rng, entry:=defText, entryautotext:=defText
Case 3 ' Cancel, exit the sub
MsgBox ("Exiting macro")
GoTo lbl_Exit
End Select
Wend
End With
lbl_Exit:
Unload myForm
Set myForm = Nothing
End Sub
(FWIW, I'm pretty new to Word VBA, but very familiar with Excel VBA). Thanks for any ideas.
Note if I click "No" (equivalent of myForm.Tag = 1), then it does move on to the next instance. Hmm.
Try adding rng.Collapse wdCollapseEnd before the "Case 1" line.
Explanation: When you use Find, it executes on the given Range or Selection.
If it's successful, that Range/Selection changes to include the "found" term. In this case, you in addition change the assignment again (expanding to include the paragraph).
When your code loops the current assignment to "Range" is used - in this case, Find looks only at the selected paragraph Range. So you need to reset the Range in order to have Find continue.
To be absolutely accurate, after Collapse you could also add:
rng.End = ActiveDocument.Content.End
Note: it's more correct to use ActiveDocument.Content than ActiveDocument.Range. ActiveDocument.Range is actually a method for creating a new Range by specifying the Start and End points, while ActiveDocument.Content returns the entire main story (body) of the document as a Range object. VBA doesn't care, it defaults the method to return the main story. Other programming languages (.NET, especially C#) don't work as intuitively with Word's object model, however. So it's a good habit to use what "always" works :-)
I am using the following VBA macro to add page numbers after all bookmark hyperlinks in my document:
Sub InsertPageRefs()
Application.ScreenUpdating = False
Dim hLnk As Hyperlink, Rng As Range
For Each hLnk In ActiveDocument.Hyperlinks
With hLnk
If InStr(.SubAddress, "_Toc") = 0 And .Address = "" Then
Set Rng = .Range
With Rng
.Collapse Direction:=wdCollapseEnd
.InsertAfter Text:=" (See page #)"
.Font.Underline = wdUnderlineNone
End With
ActiveDocument.Fields.Add Range:=Rng.Characters(InStr(Rng, "#")), Text:="PAGEREF " & .SubAddress
End If
End With
Next
Set Rng = Nothing
Application.ScreenUpdating = True
Application.ScreenRefresh
MsgBox ActiveDocument.Hyperlinks.Count & " page numbers have been added.", vbOKOnly
End Sub
However, it's having undesirable results.
The blue color of the hyperlinks is partially spilling over into the added text.
It's creating a bunch of crazy span tags when I save the resulting file to HTML. I don't want this because I am going to convert the HTML to .mobi for Kindle and all the span tags are going to create chaos in my .mobi.
How do I strip out all the formatting and insert the page numbers in the "Normal" word style?
I suspect the real answer for this would be to use a good e-book editor that will keep track of this for you.
That said, the problem is likely that you are working on the Hyperlink's range, so all you should have to do is duplicate it. This allows the formatting of your range separate itself from whatever formatting is attached to the hyperlink. The other benefit of using a duplicate of a Hyperlink's range is that you can operate on the text of the range directly without destroying the link, which is also an easy way to preserve the target formatting:
Sub InsertPageRefs()
Dim hLnk As Hyperlink
Dim Rng As Range
For Each hLnk In ActiveDocument.Hyperlinks
If InStr(hLnk.SubAddress, "_Toc") = 0 And hLnk.Address = vbNullString Then
Set Rng = hLnk.Range.Duplicate
Rng.Start = Rng.End
Rng.Text = " (See page #)"
Rng.Font.Underline = wdUnderlineNone
ActiveDocument.Fields.Add Range:=Rng.Characters(InStr(Rng, "#")), _
Text:="PAGEREF " & hLnk.SubAddress
End If
Next
MsgBox ActiveDocument.Hyperlinks.Count & " page numbers have been added.", vbOKOnly
End Sub
Note that I pulled out the With blocks to make this more readable. Nested Withs make it a lot more difficult to tell at a glance what object you're operating on.