AW: Hyperlinkpfad via Macro ändern
22.03.2012 17:07:53
dan
Hallo Anke,
hier ein Code der aendert Adresse fuer alle Hyperlinks, die mit "jpg" beendet sind in gesamtem Workbook.
Nicht vergessen:
Vor dem Makro Start solltest Du von Deiner Datei eine Back-Up Kopie machen!!! :-).
Mfg, dan, cz.
Option Explicit
' Private Const ALTER_PFAD As String = "C:\server1\Digitalbilder"
Private Const NEUER_PFAD As String = "G:\test7\Digitalbilder\"
Private Const HYPERLINK_TARGET_TYPE As String = "JPG"
Public Sub Main(): On Error GoTo Err_Main
ReplaceAllHyperlinkAddress
Exit Sub
Err_Main:
MsgBox Err.Description, vbCritical, "Error"
End Sub
Private Sub ReplaceAllHyperlinkAddress()
Dim oneSheet As Worksheet
Dim oneCell As Range
Dim oneHyperlink As Hyperlink
Dim hyperlinksCount As Long
Dim replaceCount As Long
Dim notRepacedAddresses As String: notRepacedAddresses = "Not replaced: " & vbCrLf
Dim fileName As String
For Each oneSheet In ThisWorkbook.Worksheets
For Each oneCell In oneSheet.UsedRange.Cells
For Each oneHyperlink In oneCell.Hyperlinks
hyperlinksCount = hyperlinksCount + 1
If (Strings.InStr(Strings.UCase(oneHyperlink.Address), HYPERLINK_TARGET_TYPE) > 0) Then
fileName = GetFileNameFromHyperlinkAddress(oneHyperlink.Address)
If (fileName "") Then
oneHyperlink.Address = NEUER_PFAD & fileName
replaceCount = replaceCount + 1
End If
Else
notRepacedAddresses = notRepacedAddresses & oneSheet.Name & ":" & oneHyperlink.Range. _
Address & ", " & oneHyperlink.Address & vbCrLf
End If
Next oneHyperlink
Next oneCell
Next oneSheet
If (hyperlinksCount - replaceCount > 0) Then MsgBox notRepacedAddresses, vbExclamation, " _
Caution, not all hyperlinks replaced"
End Sub
Private Function GetFileNameFromHyperlinkAddress(ByVal hyperlinkAddress As String): _
GetFileNameFromHyperlinkAddress = ""
Dim fileNameSeparatorPosition As Integer: fileNameSeparatorPosition = Strings.InStrRev( _
hyperlinkAddress, "/")
If (fileNameSeparatorPosition 0) Then GetFileNameFromHyperlinkAddress = Strings.Right( _
hyperlinkAddress, Strings.Len(hyperlinkAddress) - fileNameSeparatorPosition)
End Function