I'm trying to fix the hyperlinks in a Word document. I need to change the SubAddress property of some hyperlinks. To that end, I'm looping through them. Unfortunately, I get a very weird error saying method 'subaddress' of object 'hyperlink' failed when I try to change any SubAddress. Apparently this happens because something is broken with VBA itself.
Sub FixHyperlinks()
'
' FixHyperlinks Macro
'
'
ActiveDocument.Hyperlinks(1).SubAddress = "some new subaddress"
End Sub
I'm rocking Office 2016 Professional Plus. Can anybody tell me if this works for you?
It's easy to test. Just create a new document, type two one-word lines. Make the second line style "Heading 1". Go to first line, hit CTRK + K (to create hyperlink) point it to "a place in this document", select the heading you just created. DO NOT enter any address. Now go to Macros, paste the above and hit F5 while your caret is inside the code.
The hyperlink works fine when clicked with the mouse (first line hyperlink will take you to the 2nd line Heading).
Although Hyperlink.SubAddress Property is supposed to be a read/write string, writing to it fails - even in Word 2010. Try something along the lines of:
Dim Rng As Range, StrAddr As String, StrTxt As String
With ActiveDocument
With .Hyperlinks(1)
Set Rng = .Range
StrAddr = .Address
StrTxt = .TextToDisplay
.Delete
End With
.Hyperlinks.Add Anchor:=Rng, Address:=StrAddr, SubAddress:="new_sub_address"
End With
Related
I need to add a hyperlink to a bookmark in an MS-Word template. The hyperlink (which changes depending on user input) points to an entry in a database on the web. I have no trouble building the hyperlink as a string variable, but I can't figure out how to put it in the bookmark so the user winds up with a Word document containing a link that can be clicked to go to the database entry. My code (below) just deletes the bookmark. What am I missing?
Dim databaseURL As String
' get databaseURL from an existing variable--this part works OK
databaseURL = ActiveDocument.Variables("databaseLink")
' put the hyperlink in a bookmark named "linkToDatabase"
Dim BMRange As Range
Set BMRange = ActiveDocument.Bookmarks("linkToDatabase").Range
BMRange.Text = "Database link"
ActiveDocument.Hyperlinks.Add Anchor:=BMRange, _
Address:=databaseURL, _
SubAddress:="", ScreenTip:="", TextToDisplay:=BMRange.Text
What you could do to simplify things is to have a bookmarked 'default' hyperlink field at the bookmarked range, then simply change the hyperlink field's code. For example:
ActiveDocument.Bookmarks("linkToDatabase").Range.Fields(1).Code.Text = "HYPERLINK " & databaseURL
To summarize what I'm attempting to do, I work for a non-profit organization that sends out acknowledgement letters when someone donates money to us (a thank you, basically). We have multiple different letters that are written every month and sent to IS to "process". I would like to make this as efficient and use as little time as possible for IS, so I've created a program in VB.NET that takes content and pastes it into a template using Word bookmarks, updates a table in SQL so that the letter can be tested with live data, and sends an e-mail to the Production department letting them know to test the letter. It works fully, except...
I cannot for the life of me figure out how to retain RTF (RichText) when I insert the content into the letter template.
I've tried saving the content of the RichTextBox as an RTF file, but I can't figure out how to insert the RTF file contents into my document template and replace the bookmark.
I've tried using the Clipboard.SetText, odoc......Paste method, but it's unreliable as I can't accurately state where I'd like the text to paste. The find/replace function isn't very helpful because all of the bookmarks I'm trying to replace are within text boxes.
I'd show some code, but most of it has been deleted out of frustration for not working. Either way, here's some code I've been working with:
Private Sub testing()
strTemplateLocation = "\\SERVER\AcknowledgementLetters\TEST\TEMPLATE.dot"
Dim Selection As Word.Selection
Dim goWord As Word.Application
Dim odoc As Word.Document
goWord = CreateObject("Word.Application")
goWord.Visible = True
odoc = goWord.Documents.Add(strTemplateLocation)
Clipboard.Clear()
Clipboard.SetText(txtPreD.Rtf, TextDataFormat.Rtf)
odoc.Content.Find.Execute(FindText:="<fp>", ReplaceWith:=My.Computer.Clipboard.GetText)
'Code for looping through all MS Word Textboxes, but didn't produce desired results
For Each oCtl As Shape In odoc.Shapes
If oCtl.Type = Microsoft.Office.Core.MsoShapeType.msoTextBox Then
oCtl.TextFrame.TextRange.Text.Replace("<fp>", "Test")
goWord.Selection.Paste()
End If
Next
'Clipboard.Clear()
'Clipboard.SetText(txtPostD.Rtf, TextDataFormat.Rtf)
'odoc.Content.Find.Execute(FindText:="<bp>", ReplaceWith:="")
'goWord.Selection.Paste()
MsgBox("Click Ok when finished checking.")
odoc.SaveAs2("\\SERVER\AcknowledgementLetters\TEST\TEST.docx")
odoc = Nothing
goWord.Quit(False)
odoc = Nothing
goWord = Nothing
End Sub
...and here is the default code for setting bookmarks. This works perfectly as long as formatting is not required:
Private Sub SetBookmark(odoc As Object, strBookmark As String, strValue As String)
Dim bookMarkRange As Object
If odoc.Bookmarks.Exists(strBookmark) = False Then
Exit Sub
End If
bookMarkRange = odoc.Bookmarks(strBookmark).Range
If ((Err.Number = 0) And (Not (bookMarkRange Is Nothing))) Then
bookMarkRange.text = strValue
odoc.Bookmarks.Add(strBookmark, bookMarkRange)
bookMarkRange = Nothing
End If
End Sub
TL;DR - Need formatted text (Example: "TEST") to be inserted into a Word document either as a bookmark or as a replacement text.
Expected results: Replace "fp" (front page) bookmark with "TEST" including bold formatting.
Actual results: "fp" is not replaced (when using clipboard and find/replace method), or is replaced as "TEST" with no formatting.
I figured it out! I had to do it a weird way, but it works.
The following code saves the RichTextBox as an .rtf file:
RichTextBoxName.SaveFile("temp .rtf file location")
I then used the following code to insert the .rtf file into the bookmark:
goWord.ActiveDocument.Bookmarks("BookmarkName").Select()
goWord.Selection.InsertFile(FileName:="temp .rtf file location")
I then deleted the temp files:
If My.Computer.FileSystem.FileExists("temp .rtf file location") Then
My.Computer.FileSystem.DeleteFile("\temp .rtf file location")
End If
I’m trying to create a macro that will only spellcheck specific cells. I have succeeded in spellchecking the cells, but for some reason the spellcheck wizard keeps running afterwards and tries to check any text boxes on my spreadsheet.
Below is the code:
Range(“C8”).Select
Selection.CheckSpelling SpellLang:=1034
Updating code with suggestions, however the code is still spellchecking text boxes:
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Const dummyCell = "Z999" 'address of an empty cell
Dim cellsToCheck As Range
Set cellsToCheck = ws.Range("C8")
Union(Range(dummyCell), cellsToCheck).CheckSpelling
I cycled through and it is spellchecking the text boxes before the actual range specified in "CellsToCheck".
Programmatically check spelling of a single cell without the dialog box
If you want to programmatically check the spelling on a single cell, and you don't want the Spelling dialog box to display you can use the CheckSpelling method as it applies to the Application object.
Sub checkSpelling_NoDialog()
Dim correctlySpelled As Boolean, textToCheck As String
textToCheck = Range("A1")
correctlySpelled = Application.checkSpelling(textToCheck)
If Not correctlySpelled Then
MsgBox "Incorrect Spelling of: " & textToCheck
Else
MsgBox "Correct Spelling of: " & textToCheck
End If
End Sub
Programmatically check spelling of a single cell with the dialog box
If you do want the Spelling dialog box to display but only want to check one cell, you need to "trick Excel". Excel is designed to, if you've only selected one cell, assume you actually want to check the entire worksheet.
Sub checkSpelling_WithDialog()
Const dummyCell = "Z999" 'address of an empty cell
Dim cellsToCheck As Range
Set cellsToCheck = Range("A1")
Union(Range(dummyCell), cellsToCheck).checkSpelling
End Sub
More information on the CheckSpelling method is outlined here and here.
I have a table in a Word file A which contains a bunch of different Contents. Which I just copy using VBA into another Word or PowerPoint file B. So far that is not a problem.
However, since file A is a working sheet, people sometimes cross stuff out, which means: it should be removed, but for the record it stays in there first. In the final version it shouldnt be displayed, so in the process of copying everything in a different file, the crossed out text should be removed.
To break it down to the technical stuff:
I want to select text in a Word document, and then remove all text that has a certain formatting.
Maybe there is a special selection possibility or a way to iterate through all characters and test for formatting.
The best way to do this without suffering severe performance iterating characters or paragraphs in vba is to use find and replace.
You can do this in vba as follows, note I have wrapped all the actions in a custom undo record, then you can call your current vba routine with CopyDocumentToPowerPoint and the word document will be restored to the state it was before the macro ran (crossed out text remains in word, but is not pasted to powerpoint).
'wrap everything you do in an undo record
Application.UndoRecord.StartCustomRecord "Move to powerpoint"
With ActiveDocument.Range.Find
.ClearFormatting
.Font.StrikeThrough = True
.Text = ""
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
'copy to powerpoint and whatever else you want
CopyDocumentToPowerPoint
Application.UndoRecord.EndCustomRecord
'and put the document back to where you started
ActiveDocument.Undo
It is possible to go character-by-character and remove those which have the strikethrough font enabled on them (the ones which are crossed out) in MS Word. However, as far as I know, there is no such possibility to detect a strike-through font in MS PowerPoint.
If you just need to delete the text which has the strikethrough font on it in the selected text only, you can use this Word macro:
Sub RemoveStrikethroughFromSelection()
Dim char As Range
For Each char In Selection.Characters
If char.Font.StrikeThrough = -1 Then
char.Delete
End If
Next
End Sub
If more integrated to copying a Word table to another Word document and PowerPoint presentation, the following code might be useful. It first pastes the table to a new Word file, then removes unnecessary characters, and after that pastes this new table to PowerPoint.
Sub CopyWithoutCrossedOutText()
Dim DocApp As Object: Set DocApp = CreateObject("Word.Application")
Dim PptApp As Object: Set PptApp = CreateObject("PowerPoint.Application")
Dim Doc As Object: Set Doc = DocApp.Documents.Add
Dim Ppt As Object: Set Ppt = PptApp.Presentations.Add
Dim c As Cell
Dim char As Range
DocApp.Visible = True
PptApp.Visible = True
'Copying Word table to the 2nd Word document
ThisDocument.Tables(1).Range.Copy
Doc.ActiveWindow.Selection.Paste
'In the 2nd Word document - removing characters having strikethrough font enabled on them
For Each c In Doc.Tables(Doc.Tables.Count).Range.Cells
For Each char In c.Range.Characters
If char.Font.StrikeThrough = -1 Then
char.Delete
End If
Next
Next
'Copying the table from the 2nd Word document to the PowerPoint presentation
Doc.Tables(1).Range.Copy
Ppt.Slides.Add(1, 32).Shapes.Paste
End Sub
I'm trying to add a custom building block at the click of a button in MS word 10. Below is the code currently attached to my activeX button.
Private Sub CommandButton1_Click()
Dim objTemplate As Template
Dim objBB As BuildingBlock
' Set the template to store the building block
Set objTemplate = ActiveDocument.AttachedTemplate
' Access the building block through the type and category
Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom5) _
.Categories("General").BuildingBlocks("Experience")
' Insert the building block into the document replacing any selected text.
objBB.Insert Selection.Range
End Sub
My problem is, as this code is invoked at the click of a button, the button becomes the "Selection.Range" and is thus replaced. I looked all around for alternate codes that mention of different "where" specification and found nothing.
I only found two links(can't find the urls in my history rightnow, will update shortly)
It mentioned "Paragraphs(1)" instead of "Selection.Range", but this
is an absolute location while I would need something relative
(Before the button)
Using InsertBefore method which I suppose applies only to text (it
was used to insert text in the example) as when I tried it for
building blocks it didnt work
P.S I'm relatively new to VBA
Ok, I solved the problem with the following code, posting it for others who might drop by in the future.
Private Sub CommandButton1_Click()
Dim objTemplate As Template
Dim objBB As BuildingBlock
' Set the template to store the building block
Set objTemplate = ActiveDocument.AttachedTemplate
' Access the building block through the type and category
Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom5) _
.Categories("General").BuildingBlocks("Experience")
' Insert the building block into the document replacing any selected text.
Selection.MoveUp Unit:=wdLine, Count:=1
objBB.Insert Selection.Range
End Sub
Basically just added the following lines just before inserting the BuildingBlock
Selection.MoveUp Unit:=wdLine, Count:=1
Thanks everyone for the assistance.
When in "Creation mode", goto the "properties" toolbox of your CommandButton1, change the property TakeFocusOnClick from True to False:
The focus will stay onto the paragraph you selected.
If you want it just after your CommandButton you can add the following at the end of your sub:
...
CommandButton1.Select
Selection.HomeKey wdLine
objBB.Insert Selection.Range
End Sub