我有一个工作表,其中包含一组基于下拉菜单更改的动态超链接。只有具有下拉菜单的单元格才会被解锁。我取消选中“选择锁定的单元格”,这样当我保护工作表时,用户只能选择下拉菜单。不幸的是,当我这样做时,超链接不再可用。
有谁知道如何解决这个问题?
的 * UPDATE
根据要求,我的动态超链接单元格的代码:
=IF(ISNA(MATCH(B4,'Data Sheet'!A2:A103,0)),"",HYPERLINK(VLOOKUP(B4,'Data Sheet'!A:S,7,FALSE),VLOOKUP(B4,'Data Sheet'!A:S,5,FALSE)&" - "&VLOOKUP(B4,'Data Sheet'!A:S,6,FALSE)))
1)单元格B4是用户选择特定选项的下拉列表。超链接根据此选择而变化。
2)'数据表'是一个单独的表格,其中包含数组中的所有参考数据。
这基本上说:B4中的值是否与我的数据图表中的第一列匹配?如果是这样,请使用VLOOKUP的超链接公式将相应的URL插入公式中。
答案 0 :(得分:6)
这是我对设置和要求的理解:
设置强>
有一个带有下拉菜单的受保护工作表,用于更新包含VLOOKUP \ HYPERLINK公式的其他单元格。
工作表中的所有单元格(不包括下拉菜单)都受到保护。
包含VLOOKUP \ HYPERLINK公式的单元格的值可能等于www地址或空白,具体取决于下拉菜单的值。因此,所有超链接都指向网页或为空白。
工作表EnableSelection
设置为xlUnlockedCells
,确定工作表受保护后“只能选择未锁定的单元格。”
<强>要求强> - 需要保护工作表以保护内容,包括VLOOKUP \ HYPERLINK公式。
此解决方案使用以下资源
HYPERLINK
功能UDF
(用户定义的功能)Public Variables
和Worksheet_BeforeDoubleClick
活动当
UDF
被包装到HYPERLINK
函数中时会导致 每次鼠标悬停在包含组合的单元格上 公式HYPERLINK(UDF,[FriendlyName])
UDF
被触发。
我们将使用Public Variable
来保留LinkLocation
,以便稍后用于根据用户决定的超链接使用。
还有一秒Public Variable
来设置LinkLocation
上次更新的时间。
我们将模仿超链接“正常”激活的方式:
用户选择一个单元格并单击所选单元格中的超链接。
相反,用户使用超链接(UDF将LinkLocation
和时间输入公共变量)和DoubleClicks
单元格< em>(触发工作表事件以跟踪超链接,首先验证LinkLocation
上次更新的时间,以确保它仍然是实际的并清除LinkLocation
变量)。
首先,我们需要确保工作表中用于生成动态超链接的公式具有适当的结构:
假设当前的VLOOKUP \ HYPERLINK公式具有以下结构: (必须根据假设工作,因为未提供实际公式)
=IFERROR( HYPERLINK( VLOOKUP( DropDownCell , Range , Column, False ), FriendlyName ), "" )
我们需要将该公式更改为以下结构:
=IFERROR( HYPERLINK( UDF( VLOOKUP( DropDownCell , Range , Column, False ) ), FriendlyName ), "" )
以下程序负责修改公式结构,使其适合所提出的解决方案。 建议在名为“维护”的单独模块中复制两者。
Option Explicit
Private Sub Wsh_FmlHyperlinks_Reset()
Const kWshPss As String = "WshPssWrd"
Const kHypLnk As String = "HYPERLINK("
Dim WshTrg As Worksheet, rHyplnk As Range
Dim rCll As Range, sHypLnkFml As String
Dim sOld As String, sNew As String
Rem Application Settings
Application.EnableEvents = False
Application.ScreenUpdating = False
Rem Set & Unprotect Worksheet
Set WshTrg = ActiveSheet
WshTrg.Unprotect kWshPss
Rem Find Hyperlink Formulas
If Not (Rng_Find_Set(WshTrg.UsedRange, _
rHyplnk, kHypLnk, xlFormulas, xlPart)) Then Exit Sub
If rHyplnk Is Nothing Then Exit Sub
Rem Add Hyperlinks Names
For Each rCll In rHyplnk.Cells
With rCll
sHypLnkFml = .Formula
sOld = "HYPERLINK( VLOOKUP("
sNew = "HYPERLINK( Udf_HypLnkLct_Set( VLOOKUP("
sHypLnkFml = Replace(sHypLnkFml, sOld, sNew)
sOld = ", FALSE ),"
sNew = ", FALSE ) ),"
sHypLnkFml = Replace(sHypLnkFml, sOld, sNew)
.Formula = sHypLnkFml
End With: Next
Rem Protect Worksheet
WshTrg.EnableSelection = xlUnlockedCells
WshTrg.Protect Password:=kWshPss
Rem Application Settings
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Function Rng_Find_Set(rInp As Range, rOut As Range, _
vWhat As Variant, eLookIn As XlFindLookIn, eLookAt As XlLookAt) As Boolean
Dim rFound As Range, sFound1st As String
With rInp
Set rFound = .Find( _
What:=vWhat, After:=.Cells(1), _
LookIn:=eLookIn, LookAt:=eLookAt, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not (rFound Is Nothing) Then
sFound1st = rFound.Address
Do
If rOut Is Nothing Then
Set rOut = rFound
Else
Set rOut = Union(rOut, rFound)
End If
Set rFound = .FindNext(rFound)
Loop While rFound.Address <> sFound1st
End If: End With
Rem Set Results
If Not (rOut Is Nothing) Then Rng_Find_Set = True
End Function
这些是公共变量和UDF。 建议将它们复制到一个单独的模块中。
Option Explicit
Public psHypLnkLoct As String, pdTmeNow As Date
Public Function Udf_HypLnkLct_Set(sHypLnkFml As String) As String
psHypLnkLoct = sHypLnkFml
pdTmeNow = Now
End Function
并使用动态生成的超链接在受保护工作表的模块中复制此过程。
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Now = pdTmeNow And psHypLnkLoct <> Empty Then
ThisWorkbook.FollowHyperlink Address:=psHypLnkLoct, NewWindow:=True
End If
End Sub
答案 1 :(得分:2)
如果您乐意使用VBA,可以使用以下代码来处理相关的工作表,这将复制超链接的click事件并尝试以目标的本机格式打开
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If InStr(1, Target.Formula, "HYPERLINK", vbTextCompare) > 0 Then
On Error Resume Next
Target.Hyperlinks(1).Follow (True)
On Error GoTo 0
End If
End Sub
<强>更新强>
我想我有一点工作要做。我从here中捏了一些代码,允许翻转操作触发一些vba。所以,假设您在单元格A1中有链接。将您的链接更改为以下内容:
=IFERROR(HYPERLINK(MyMouseOverEvent("http://www.google.com"),"Hover"),"Hover")
您可以动态更改链接,前提是它返回一个字符串。现在创建一个新模块并粘贴以下内容:
Public Function MyMouseOverEvent(varLink As String)
varResponse = MsgBox("Would you like to open link to: '" & varLink & "'?", vbYesNo, "Confirm")
If varResponse = vbYes Then
ActiveWorkbook.FollowHyperlink Address:=varLink, NewWindow:=True
End If
End Function
唯一的缺点是它会在悬停而不是点击时触发代码,但弹出框将允许用户决定是否要关注所述链接。我会一直看着它,看看我是否能找到一个工作点,但是我觉得它正在发展,因为它会在完全受保护的情况下触发。如果有帮助,我正在使用Excel 2010。