Make hyperlink in macro using Clipboard

[Testeris]

Hi all,
I am trying to create a word file to use with another macro. I need to select some text and make it hyperlink that I copy/cut from a line below (it is automatically generated in Excel and linked/updated at the time of opening the doc). The result is cut and saved into separate Word files, as part of a big batch file.



So far I scroll, select and cut the hyperlink text I need. Then I go back several numbers to select the reference and run a subroutine to paste in the hyperlink text onto my selection.


What I encounter is error "DataObject:getfromclipboard openclipboard failed". I debug, yellow arrow at "MyData.GetFromClipboard" and when clicked the green arrow (F5) it goes through as expected.



I can't get it done in one go. What I am doing wrong?

Sorry, I am "copypaster" only. My suspicion is that CUT does not put into Clipboard, so I tried to COPY and then cut, and both...

P.S. An example of the text in Bulgarian (I am not)


... several lines...
Текстовете, приети на 4 май 2022 г. относно освобождаването от отговорност във връзка с изпълнението на Бюджет 2020 г., са публикувани в [Here goes the hyperlink]-->ОВ L 258, 5.10.2022.
https://eur-lex.europa.eu/legal-content/BG/TXT/?uri=OJ%3AL%3A2022%3A258%3AFULL
... several lines...


My "macro":
Sub aMacro1()
'
' aMacro1 Macro
'
Dim MyData As DataObject
Dim strAddr As String
Dim strTitle As String
Set MyData = New DataObject

Selection.HomeKey Unit:=wdStory
Selection.MoveDown Unit:=wdParagraph, Count:=9
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
' cut the link text
' Selection.Copy
Selection.Cut
MyData.GetFromClipboard
strAddr = MyData.GetText

' selecting the location where to overlay
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.MoveLeft Unit:=wdWord, Count:=10, Extend:=wdExtend
' sub to put in the hyperlink -->
' Commented FOR REUSING IF IT FAILS
' Dim MyData As DataObject
' Dim strAddr As String
' Dim strTitle As String

' On Error Resume Next - skipped the error but did not do the job

' MyData.GetFromClipboard
' strAddr = MyData.GetText

' Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
' Selection.Copy
' MyData.GetFromClipboard

ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=strAddr, SubAddress:="", ScreenTip:="", TextToDisplay:=Selection.Range

' End of the insert

' return to the beginning of the page and/or continue to other macto
Selection.HomeKey Unit:=wdStory
End Sub


Thanks

[Testeris]

I used this as inspiration:
word use vba to create a hyperlink from clipboard - Stack Overflow

Apparently, the URL does not get to Clipboard when cutting...

[gmayor]

The problem with your macro is not the cutting of the selection, but the selection itself.
What does

Selection.HomeKey Unit:=wdStory
Selection.MoveDown Unit:=wdParagraph, Count:=9
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend

actually select?

[Testeris]

Hi,

Here I move down, select the line and go left to exclude CR.

And in the next line I make the cut.
Actually that's the macro recorder's code, how it sees it.


The problem is that macro saves the actual URL, but next time I would need to manually edit the macro to have another reference. That's why all this.

[Testeris]

I guess my VBA misses smth. See another problem, maybe related. Recorded it, but when running, error.



Sub aMakePlainText()
'
' aMakePlainText Macro
'
'
Selection.HomeKey Unit:=wdStory
Selection.WholeStory
Selection.Cut
Selection.PasteAndFormat (wdFormatPlainText) '<-- error here
Selection.HomeKey Unit:=wdStory
End Sub


Stops at PasteAndFormat, error 4198

[gmayor]

Put the cursor in the first line of the link text and run the following to hyperlink that text.

Sub Macro1()
Dim oRng As Range
Dim sLink As String
    Selection.HomeKey
    Set oRng = Selection.Range
    oRng.MoveEndUntil Chr(11)
    sLink = oRng.Text
    oRng.Hyperlinks.Add oRng, sLink
End Sub

[Testeris]

Thank you, but nope. Not working.
Stops at oRng.Hyperlinks.Add oRng, sLink


That's what I am looking for


Imgur: The magic of the Internet

[gmayor]

Change Chr(11) to Chr(13).
or

Sub Macro1()
Dim oRng As Range
Dim sLink As String
    Selection.HomeKey
    Set oRng = Selection.Paragraphs(1).Range
    oRng.End = oRng.End - 1
    sLink = oRng.Text
    oRng.Hyperlinks.Add oRng, sLink
End Sub

[Testeris]

Great, this part worked! So now, how to put it on the text needed?

When I insert the code into my macro, it still overlays on the URL text.
Is it HomeKey that shows the insert location? (Sorry, I know I am wondering in the mist)
This is how it looks in my macro: Imgur: The magic of the Internet
The code so far:
Sub aOverlayHTMLDecharges()
'
' aOverlayHTMLDecharges Macro
'
Dim MyData As DataObject
Dim strAddr As String
Dim strTitle As String
Set MyData = New DataObject
' Dim clipboard As MSForms.DataObject
' Set clipboard = New MSForms.DataObject
Dim oRng As Range
Dim sLink As String
' On Error Resume Next

Selection.HomeKey Unit:=wdStory
Selection.MoveDown Unit:=wdParagraph, Count:=9
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
' cut the link text
' Selection.Copy
' Selection.Cut

' here?
Selection.HomeKey
Set oRng = Selection.Paragraphs(1).Range
oRng.End = oRng.End - 1
sLink = oRng.Text

' oRng.Hyperlinks.Add oRng, sLink



' clipboard.SetText Selection.Hyperlinks(1).Address
' clipboard.PutInClipboard

' MyData.GetFromClipboard '<-- not sure where in the code to put it
' strAddr = MyData.GetText

' selecting the location where to overlay - TO MODIFY
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.MoveLeft Unit:=wdWord, Count:=9, Extend:=wdExtend

' sub to put in the hyperlink -->
MyData.GetFromClipboard
strAddr = MyData.GetText

' What to do with these? Which one on the new selection?
oRng.Hyperlinks.Add oRng, sLink
' ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=strAddr, SubAddress:="", ScreenTip:="", TextToDisplay:=Selection.Range

' End of the insert

' return to the beginning of the page and/or continue to other macto
Selection.HomeKey Unit:=wdStory
End Sub

[gmayor]

The macro I posted adds the hyperlink to the hyperlink text. If you want it at that new location see below. It is not clear whether you want to move the link or copy it at that location. If you want it copied, remove the line oRng.Text = ""

Sub Macro1()
Dim oRng As Range
Dim sLink As String
Selection.HomeKey    'start of paragraph
    Set oRng = Selection.Paragraphs(1).Range
    oRng.End = oRng.End - 1
    sLink = oRng.Text

    'remove the original hyperlink
    oRng.Text = ""

    'set the range to the new location
    oRng.MoveStartUntil "-", wdBackward
    oRng.Start = oRng.Start - 2
    'collapse the range to its start
    oRng.Collapse 1
    'add the hyperlink
    oRng.Hyperlinks.Add oRng, sLink
    Set oRng = Nothing
End Sub

[Testeris]

Thank you, GMayor for your time.

I feel very uncomfortable, but it still doesn't perform exactly as needed. This is what we have accomplished so far. I added "text to display" to the code. The selection where to post will be different for each language.

Imgur: The magic of the Internet

In short, it still needs to replace the selected text with the hyperlinked text (see 2nd example what it does now)

Sub aOverlayHTMLDecharges()
  '
  ' aOverlayHTMLDecharges Macro
  '
      Dim MyData As DataObject
      Dim strAddr As String
      Dim strTitle As String
      Set MyData = New DataObject
   
      Dim oRng As Range
      Dim sLink As String
  ' Selecting the HTML line - CHR13 - COMMENTED OUT
      Selection.HomeKey Unit:=wdStory
      Selection.MoveDown Unit:=wdParagraph, Count:=9
      Selection.EndKey Unit:=wdLine, Extend:=wdExtend
      Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
  '   cut the link text
  '   Selection.Copy
  '    Selection.Cut
   
  ' GMAYOR code - selecting URL
      Selection.HomeKey
      Set oRng = Selection.Paragraphs(1).Range
      oRng.End = oRng.End - 1
      sLink = oRng.Text
   
      'remove the original hyperlink
      oRng.Text = ""
   
  '    clipboard.SetText Selection.Hyperlinks(1).Address
  '    clipboard.PutInClipboard
          
  '    MyData.GetFromClipboard  '<-- not sure where in the code to put it
  '    strAddr = MyData.GetText
      
  ' selecting the location where to overlay - TO MODIFY FOR EACH LANGUAGE

      Selection.MoveLeft Unit:=wdCharacter, Count:=2   '
      Selection.MoveLeft Unit:=wdWord, Count:=9, Extend:=wdExtend '
   
  'TESTING
      'set the range to the new location
  '    oRng.MoveStartUntil "-", wdBackward
  '    oRng.Start = oRng.Start - 21
      'collapse the range to its start
  '    oRng.Collapse 1
   
  ' sub to put in the hyperlink   -->
      MyData.GetFromClipboard
      strAddr = MyData.GetText
   
  '  What to do with these? Which one on the new selection?
  '    oRng.Hyperlinks.Add oRng, sLink
   
      oRng.Hyperlinks.Add oRng, sLink, SubAddress:="", ScreenTip:="", TextToDisplay:=Selection.Range
  '    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=strAddr, SubAddress:="", ScreenTip:="", TextToDisplay:=Selection.Range
   
  ' End of the insert
   
  Set oRng = Nothing
   
  ' return to the beginning of the page and/or continue to other macro
      Selection.HomeKey Unit:=wdStory
  End Sub

[Testeris]

Oh thanks, finally it worked!

' selecting the location where to overlay - TO MODIFY
Selection.MoveLeft Unit:=wdCharacter, Count:=2 '
Selection.MoveLeft Unit:=wdWord, Count:=9, Extend:=wdExtend '

Set oRng = Selection.Range ' I used this to mark the place where to post


So final result looks like this:
Imgur: The magic of the Internet


Thank you again!

[macropod]

Testeris:

When posting code, kindly enclose it in the code tags (inserted via the # button on the posting menu). Otherwise, your code loses whatever structure it has. See post #8.

Kindly also post images etc. here, via the paperclip button on the 'Go Advanced' screen, instead of posting links to 3rd-party sites from where the images etc. are liable to be deleted.