Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
Lolalola
 | Femeie
22 ani
Cluj
cauta Barbat
26 - 80 ani |
|
Mrrrr
AdMiN
 Inregistrat: acum 17 ani
Postari: 2228
|
|
Source:
Let's say you have a database of some sort with about 100 entries and 100 hyperlinks to some files.
You're doing a cleaning and archiving of old stuff, renaming your folders, moving them, etc. Then you remember that your database is locked to those folder names and locations.
Well, you can do something about it!
I hope I can make this as clear as possible as I am not the creator of the following macro code, I'm just a happy user who stumbled upon the problem and found the solution online. Credits to others. Enough said, let's see the solution to this problem.
Open the document where you want the hyperlinks changed.
For Office 2007/2010 you have to go to the DEVELOPER ribbon, find the VIEW CODE button and click it to open the Visual Basic editor.
No DEVELOPER ribbon? Go to Excel Options - Customize Ribbons - Main Tabs and select it (it's in the list on the right of the Customize Ribbons window).
This may work in Office 2013 too, I don't really know how ribbons look like in there. Also dunno about the way to access Visual Basic in Office 2003 and earlier versions. But you're smart, you can figure it out.
In Visual Basic copy/paste the code between quote tags at the bottom of this post.
You will have to replace values for OldStr and NewStr with your own and then run the code.
For example: I only changed the name of one of the folders on the path where the documents were stored in. "AAAA\ABAB" was changed to "BBBB\ABAB", without changing the other part of the path, like C:\bla bla\bla blu\bla.
The command edits hyperlinks as text line, so you can replace only parts of the links (paths).
Before you run the following code, please make a backup of your document, just in case.
Here is the code:
Sub Fix192Hyperlinks()
Dim OldStr As String, NewStr As String
OldStr = "AAAA\ABAB"
NewStr = "BBBB\ABAB"
Dim hyp As Hyperlink
For Each hyp In ActiveSheet.Hyperlinks
hyp.Address = Replace(hyp.Address, OldStr, NewStr)
Next hyp
End Sub |
_______________________________________
|
|
| pus acum 11 ani |
|
TonyTzu
Moderator
 Inregistrat: acum 12 ani
Postari: 252
|
|
For the code below there is a dialog box that appears asking you what text you want to replace, then the text you want to be inserted:
Sub ReplaceHyperlinks()
Dim Ws As Worksheet
Dim xHyperlink As Hyperlink
Dim xOld As String, xNew As String
xTitleId = "KutoolsforExcel"
Set Ws = Application.ActiveSheet
xOld = Application.InputBox("Old text:", xTitleId, "", Type:=2)
xNew = Application.InputBox("New text:", xTitleId, "", Type:=2)
Application.ScreenUpdating = False
For Each xHyperlink In Ws.Hyperlinks
xHyperlink.Address = Replace(xHyperlink.Address, xOld, xNew)
Next
Application.ScreenUpdating = True
End Sub
|
Another version of the macro from post #1 (without dialog boxes)
Sub FixHyperlinks()
Dim wks As Worksheet
Dim hl As Hyperlink
Dim sOld As String
Dim sNew As String
Set wks = ActiveSheet
sOld = "text to replace"
sNew = "replacing text"
For Each hl In wks.Hyperlinks
hl.Address = Replace(hl.Address, sOld, sNew)
Next hl
End Sub
|
|
|
| pus acum 7 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 787
|
|
Updated code from post #2 with with InputBoxes but also with X/Cancel/empty field handling:
Sub ReplaceHyperlinks()
Dim Ws As Worksheet
Dim xHyperlink As Hyperlink
Dim xOld As String, xNew As String
xTitleId = "Change HLNKs"
Set Ws = ActiveSheet
xOld = InputBox("Old text:", xTitleId, "")
If StrPtr(xOld) = 0 Or xOld = vbNullString Or xOld = "" Then
Set Ws = Nothing
xTitleId = ""
MsgBox "Ai dat X, cancel, sau ai lasat campul liber." & vbCrLf & vbCrLf & _
"Nu s-a facut nicio modificare!"
Exit Sub
End If
xNew = InputBox("New text:", xTitleId, "")
If StrPtr(xNew) = 0 Or xNew = vbNullString Or xNew = "" Then
Set Ws = Nothing
xTitleId = ""
MsgBox "Ai dat X, cancel, sau ai lasat campul liber." & vbCrLf & vbCrLf & _
"Nu s-a facut nicio modificare!"
Exit Sub
End If
Application.ScreenUpdating = False
For Each xHyperlink In Ws.Hyperlinks
xHyperlink.Address = Replace(xHyperlink.Address, xOld, xNew)
Next
Application.ScreenUpdating = True
End Sub |
|
|
| pus acum 5 luni |
|