In Excel, how do you create a macro for converting hyperlinks of short
phrases, back to a full URL? I've tried, but the macros created from
Hyperlink Box (Shortcut CTL-K) always insert the same text in the
"Text to Display" field instead of the URL that I've copied from the
Hyperlink field.
Thanks |
Clarification of Question by
socr2-ga
on
12 Mar 2003 11:01 PST
That is "Need to automate conversion of hyperlinks back to full URL in
Excel." Sorry for the spelling error.
|
Request for Question Clarification by
googleexpert-ga
on
14 Mar 2003 10:23 PST
do you mean this conversion,
index.html --> http://somesite.com/index.html
can you give an example of what the conversion should be?
|
Clarification of Question by
socr2-ga
on
14 Mar 2003 11:26 PST
Yes exactly. I want to change a hyperlinked document name to its full URL address.
|
Clarification of Question by
socr2-ga
on
14 Mar 2003 11:32 PST
Here's an example stamp.jpg -->
http://washingtonstamps.com/china/stamp.jpg. Stamp.jpg is hyperlinked
already to the address because it was imported into Excel from a table
with a Web Query. The full URL is needed in the Excel spreadsheet,
not just the hyperlink. I was able to do the change manually one by
one but the macro wouldn't work. I tried about 15 differennt macro
permuatations, even switching to Internet Explorer and copying the URL
from there. The macros all put a stic entry in for the text instead
of a field for whatever is on the clipboard. Don't know enough about
Visual Basic to fix the macros.
|
Try something like this - If your address is in A1, and you want the
full URL to appear in A2:
Range("A2") = Range("A1").Hyperlinks(1).Address
To make the value in A2 an actual link that goes to the same place as
A1:
Range("A2").Hyperlinks.Add Range("A2"),
Range("A1").Hyperlinks(1).Address
For additional information, look in Excel Help at the Hyperlinks
collection.
- Hammer |
Request for Answer Clarification by
socr2-ga
on
14 Mar 2003 15:12 PST
Hi, thanks. This worked and gave me what I wanted.
Sub Replace_Hyperlink()
'
' Replace_Hyperlink Macro
' Macro recorded 3/14/2003 by Paul Pruitt
'
' Keyboard Shortcut: Ctrl+l
Selection.Hyperlinks(1).TextToDisplay = _
Selection.Hyperlinks(1).Address
ActiveCell.Offset(1, 0).Range("A1").Select
End Sub
Thanks, because you gave me the idea. If the next cell is blank
though I get subcript out of range. How do i skip to the next cell?
|
Clarification of Answer by
hammer-ga
on
15 Mar 2003 05:37 PST
Try this routine. It will do an entire column at once. It checks for
blank values and non-hyperlink values.
Note: none of the lines of code should wrap. The answer box may wrap
them.
Sub Replace_Hyperlink()
' This routine will work on the first 500
' cells in column A. To do more rows, increase
' the value counter loops to (max_counter). To do a different
' column, change the column index (col_index) to the
' correct column.
Dim counter As Integer
Dim col_index As Integer
Dim max_counter As Integer
col_index = 1 ' Column to operate on
max_index = 500 ' Number of rows to change
For counter = 1 To max_index
If Cells(counter, col_index).Value <> "" Then
If Cells(counter, col_index).Hyperlinks.Count > 0 Then
Cells(counter, col_index).Hyperlinks(1).TextToDisplay
= Cells(counter, col_index).Hyperlinks(1).Address
End If
End If
Next counter
End Sub
- Hammer
|
Clarification of Answer by
hammer-ga
on
15 Mar 2003 05:50 PST
Oops. Typo.
Use this fixed rotuine instead:
Sub Replace_Hyperlink()
' This routine will work on the first 500
' cells in column A. To do more rows, increase
' the value counter loops to (max_counter). To do a different
' column, change the column index (col_index) to the
' correct column.
Dim counter As Integer
Dim col_index As Integer
Dim max_counter As Integer
col_index = 1 ' Column to operate on
max_counter = 500 ' Number of rows to change
For counter = 1 To max_counter
If Cells(counter, col_index).Value <> "" Then
If Cells(counter, col_index).Hyperlinks.Count > 0 Then
Cells(counter, col_index).Hyperlinks(1).TextToDisplay
= Cells(counter, col_index).Hyperlinks(1).Address
End If
End If
Next counter
End Sub
|
