保护工作表时不能使用超链接而不允许用户selectlocking的单元格
我有一个工作表，有一个dynamic的超链接，基于下拉菜单的变化。 只有下拉菜单的单元格被解锁。 我有“selectlocking的单元格”未选中，以便当我保护工作表时，用户只能select下拉菜单。 不幸的是，当我这样做时，超链接不再可用。
有谁知道如何解决这个问题？
UPDATE *
根据要求，我的dynamic超链接单元的代码：
=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是用户select特定选项的下拉菜单。 超链接基于这个select而改变。
2）“数据表”是一个单独的表格，用于存放数组中的所有参考数据。
这基本上说：B4中的值是否与我的数据表中的第一列相匹配？ 如果是这样，请使用VLOOKUP将超链接公式插入到公式中。
这是我对设置和要求的理解：
设置
-
有一个带有下拉菜单的受保护的工作表，用于更新其他包含VLOOKUP \ HYPERLINK公式的单元格。
-
工作表中的所有单元格（不包括下拉菜单）都受到保护。
-
包含VLOOKUP \ HYPERLINK公式的单元格的值可能等于www地址或空白，具体取决于下拉菜单的值。 因此，所有超链接指向网页或空白。
-
工作表
EnableSelection被设置为xlUnlockedCells，它确定一旦工作表被保护“只有解锁的单元格可以被选中”。
要求 – 需要保护工作表受到保护，以保护VLOOKUP \ HYPERLINK公式等内容。
- 需要允许用户select\仅激活未受保护的单元主要是出于审美的原因，并提供专业的产品。
该解决scheme使用以下资源
-
HYPERLINKfunction -
UDF（用户定义的函数） - 两个
Public Variables和 -
Worksheet_BeforeDoubleClick事件
当一个
UDF被包装成HYPERLINK函数时，它会导致 每当鼠标hover在包含HYPERLINK(UDF,[FriendlyName])的 组合 公式 的单元格上时HYPERLINK(UDF,[FriendlyName])UDF就会被触发。
我们将使用Public Variable来保存LinkLocation ，稍后用户可以根据用户的决定遵循超链接。
第二个Public Variable用于设置LinkLocation上次更新的时间。
我们将模仿超链接“正常”激活的方式：
-
用户通过它select一个单元并点击所选单元中的超链接。
-
相反，用户通过超链接（UDF将链接
LinkLocation和时间馈送到公共variables）hover在单元格上，然后DoubleClicks单元格（触发工作表事件以跟随超链接，首先validation上次更新链接位置的时间以确保它仍然是实际的，并清除LinkLocationvariables） 。
首先，我们需要确保工作表中用于生成dynamic超链接的公式具有适当的结构：
假设当前的VLOOKUP \ HYPERLINK公式具有以下结构:( 必须根据假设工作，因为没有提供实际的公式）
=IFERROR( HYPERLINK( VLOOKUP( DropDownCell , Range , Column, False ), FriendlyName ), "" )
我们需要改变这个公式到以下结构：
=IFERROR( HYPERLINK( UDF( VLOOKUP( DropDownCell , Range , Column, False ) ), FriendlyName ), "" )
以下程序负责修改公式结构以使其适用于所提出的解决scheme。 build议复制两个名为“维护”的单独模块。
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
这些是公共variables和UDF。 build议将它们复制到单独的模块中。
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
并使用dynamic生成的超链接将此过程复制到受保护的工作表的模块中 。
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
如果您很高兴使用VBA，您可以使用下面的代码来查找有问题的表单，这将复制超链接的单击事件，并尝试打开目标的本机格式
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
更新
我想我有一些工作。 我从这里捏了一些代码，允许翻转动作来触发一些vba。 所以，假设你在A1单元格中有链接。 将您的链接更改为以下内容：
=IFERROR(HYPERLINK(MyMouseOverEvent("http://www.google.com"),"Hover"),"Hover")
你可以改变你的链接dynamic提供它返回一个string。 现在创build一个新的模块并粘贴在以下内容中：
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
唯一的缺点是，它会触发hover的代码，而不是点击，但popup框将允许用户决定是否要跟随所述链接。 我会继续看着它，看看能不能find点击的工作，但是我认为它正在进步，因为即使在受到充分保护的情况下它也会启动。 如果有帮助，我正在使用Excel 2010。