基於另一個單元格值的超鏈接單元格

Question

我已經瀏覽了尋找解決方案的論壇。

我有一個基於列B單元格值創建超鏈接的代碼。它的作品，但只有當我運行子選擇單元格時。

我需要的是如果H列的值的小區是「OK」

Sub Hyperlinks() 

Dim r As Range 
Dim FilePath As String 

If Intersect(Columns("B"), Selection) Is Nothing Then Exit Sub 

For Each r In Intersect(Selection, Range("B2:B" & _ 
Cells(Rows.Count, "B").End(xlUp).Row)) 
If r <> vbNullString Then 

FilePath = "T:\BLUEMAC\Search Paths\PDF MASTER FOLDER\" 

ActiveSheet.Hyperlinks.Add Anchor:=r, _ 
Address:=FilePath & r.Value & ".pdf", TextToDisplay:=r.Value 
End If 
Next r 

End Sub 

任何幫助，將不勝感激即可自動添加超鏈接。

Answer 1

變化

If Intersect(Columns("B"), Selection) Is Nothing Then Exit Sub 

For Each r In Intersect(Selection, Range("B2:B" & _ 
Cells(Rows.Count, "B").End(xlUp).Row)) 

要

For Each r In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row) 

而且

ActiveSheet.Hyperlinks.Add Anchor:=r, _ 
Address:=FilePath & r.Value & ".pdf", TextToDisplay:=r.Value 

要

If r.offset(0,6).value = "ok" then ActiveSheet.Hyperlinks.Add Anchor:=r, _ 
Address:=FilePath & r.Value & ".pdf", TextToDisplay:=r.Value 

Answer 2

是否這樣？

Sub Hyperlinks() 

Dim r As Range 
Dim FilePath As String 

If Intersect(Columns("B"), Selection) Is Nothing Then Exit Sub 

For Each r In Intersect(Selection, Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)) 
    If r <> vbNullString And LCase$(r.Offset(0, 6).value) = "ok" Then 
     FilePath = "T:\BLUEMAC\Search Paths\PDF MASTER FOLDER\" 
     ActiveSheet.Hyperlinks.Add Anchor:=r, _ 
      Address:=FilePath & r.Value & ".pdf", TextToDisplay:=r.Value 
    End If 
Next r 

End Sub