オプション1:シートにおいてUDF
あなたはユーザ定義関数(UDF)GetUrl
を介してURLを更新するワークシートベースの方法のような標準的なモジュールに(わずかに変更)Igorによって次のコードを使用することができ、 HYPERLINK
関数内にラップして、クリック可能なリンクがあることを確認します。標準モジュールで
UDFコード:
Option Explicit
Function GetURL(cell As Range, Optional default_value As Variant) as hyperlink
'Lists the Hyperlink Address for a Given Cell
'If cell does not contain a hyperlink, return default_value
If (cell.Hyperlinks.Count <> 1) Then
GetURL = default_value
Else
GetURL = cell.Hyperlinks(1).Address
End If
End Function
あなたは、例えば、シート2のセルに持つことによって展開
=HYPERLINK(GetURL(Sheet1!A1))
そして、シート1つのセルA1
次は、ハイパーリンクビーイングを持っています更新しました。
イベントにUDF(計算)をリフレッシュして、ハイパーリンクのテキストが確実に更新されるようにする必要があります。
たとえば、UDFを含むシートでは、再計算を強制するためにGreg Glynnを次のように使用できます。確かにこれを行うための効率的な方法を見つけることができます。上記のコードのために議論したように
Private Sub Worksheet_Activate()
Cells.Replace What:="=", Replacement:="=", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub
:更新されたハイパーリンクを有するA1
細胞
細胞A3
(異なるシート内のセルである可能性がある)関数GetURL
は、内部に包まれていますHYPERLINK
ファンクションは、A1
を指します。
機能コードは標準モジュールに行くだろう:
押しAltキー + F11 VBEを開き、プロジェクトエクスプローラウィンドウで、右クリックInsert Module
をクリックしてコードを入力します表示されるモジュールに
例えば機能を含む各シートのためのワークシート・コード・ウィンドウに行くだろうトリガ・コード(SOハイパーテキスト更新)シート4がでGetUrl
機能を持っていた場合は、次のようにシートのコードウィンドウに入力します。
私がコメントで言ったように、これは各シートがアクティブになったときに呼び出される関数に入れることができます。
オプション2:マクロに関連付けられているワークシートにボタン、古いURLと新しいURL
あるいは、最適化されたが、私は他の人のように更新して幸せされていない以下を含む範囲を選択を促しますチップでコメントします。
Option Explicit
Public Sub ReplaceLinks()
Dim linksArr()
Application.ScreenUpdating = False
Dim myRange As Range
Set myRange = Application.InputBox("Please select both columns containing range of hyperlinks to update", Type:=8)
If Not myRange Is Nothing And myRange.Columns.Count = 2 Then
linksArr = myRange.Value
Else
MsgBox "Please select a range of two columns"
Exit Sub
End If
ReDim Preserve linksArr(1 To UBound(linksArr), 1 To 3)
linksArr = ValidateUrls(linksArr)
Dim currentLink As Long
For currentLink = LBound(linksArr, 1) To UBound(linksArr, 1)
If linksArr(currentLink, 3) Then
UpdateMyHyperlink CStr(linksArr(currentLink, 1)), CStr(linksArr(currentLink, 2))
End If
Next currentLink
WriteValidationResults linksArr, myRange
End Sub
Private Function ValidateUrls(ByVal linksArr As Variant) As Variant
Dim currentLink As Long
For currentLink = LBound(linksArr, 1) To UBound(linksArr, 1)
linksArr(currentLink, 3) = IsURLGood(CStr(linksArr(currentLink, 1)))
Next currentLink
ValidateUrls = linksArr
End Function
Public Function IsURLGood(ByVal url As String) As Boolean
'https://www.experts-exchange.com/questions/27240517/vba-check-URL-if-it-is-active-or-not.html by m4trix
Dim request As WinHttpRequest
Set request = New WinHttpRequest
On Error GoTo IsURLGoodError
request.Open "HEAD", url
request.Send
IsURLGood = request.Status = 200
Exit Function
IsURLGoodError:
IsURLGood = False
End Function
Private Sub UpdateMyHyperlink(ByVal oldUrl As String, ByVal newUrl As String)
Dim ws As Variant
Dim hyperlink As Variant
For Each ws In ThisWorkbook.Worksheets
For Each hyperlink In ws.Hyperlinks
If hyperlink.Address = oldUrl & "/" Then
hyperlink.Address = Application.WorksheetFunction.Substitute(hyperlink.Address, oldUrl, newUrl)
hyperlink.TextToDisplay = newUrl
End If
Next
Next
End Sub
Private Sub WriteValidationResults(ByVal linksArr As Variant, ByRef myRange As Range)
Dim isUrlValidOutput As Range
Set isUrlValidOutput = myRange.Offset(, 2).Resize(myRange.Rows.Count, 1)
isUrlValidOutput = Application.Index(linksArr, , 3)
isUrlValidOutput.Offset(-1, 0).Resize(1) = "Valid URL"
End Sub
そして、あなたが設定します - これは単に、あなたがボタンに付ける標準モジュール(あなたはまた、リボンに[開発]タブを追加する必要があり、GoogleはExcelでボタンにマクロを割り当てる)に置くの手順になります次のように(列Dは、コードを介して添加される)までのデータ:
フォームの追加制御ボタン:
自動的にそれはあなたがして、更新リンク手順を割り当てることができ、ウィンドウをポップアップ表示されます:
注:ハイパーリンクは、ワークブック内ではなく外部リンクです。 – LadyStensberg