Нельзя использовать гиперссылку при защите листов, не позволяя пользователю выбирать заблокированные ячейки

Ответ 1

Это мое понимание настроек и требований:

Настройки

• Существует защищенный рабочий лист с выпадающим меню, в котором обновляются другие ячейки, содержащие формулы VLOOKUP\HYPERLINK.

• Все ячейки на листе, за исключением выпадающих меню, защищены.

• Значение ячеек, содержащих формулы VLOOKUP\HYPERLINK, может быть равно адресу www или пустому в зависимости от значения раскрывающегося меню. Таким образом, все гиперссылки указывают на веб-страницы или пусты.

• Рабочий лист EnableSelection установлен на xlUnlockedCells, который определяет, что после того, как рабочий лист защищен. "Можно выбрать только разблокированные ячейки".

Требования  - Необходимо сохранить рабочий лист, защищенный для защиты содержимого, включая формулы VLOOKUP\HYPERLINK.

• Необходимо разрешить пользователям выбирать\активировать только незащищенные ячейки в основном по эстетическим соображениям и предоставлять профессиональный продукт.

В этом решении используются следующие ресурсы

• Функция HYPERLINK
• An UDF (пользовательская функция)
• Два Public Variables и
• Событие Worksheet_BeforeDoubleClick

Когда UDF завернуто в функцию HYPERLINK, это приводит к тому, что каждый раз, когда мышь нависает над ячейкой, содержащей комбинированные формула HYPERLINK(UDF,[FriendlyName]) запускается UDF.

Хорошо используйте Public Variable для хранения LinkLocation, который будет использоваться позже, чтобы следовать за гиперссылкой по решению пользователей.

И второй Public Variable, чтобы установить время последнего обновления LinkLocation.

Хорошо имитировать способ активации гиперссылки:

• посредством которого пользователь выбирает ячейку и нажимает гиперссылку в выбранной ячейке.

• Вместо этого пользователь наводил на ячейку гиперссылку (UDF передает LinkLocation и время в общедоступные переменные) и DoubleClicks ячейку (инициируя событие листа, чтобы следовать за гиперссылкой, сначала проверяя время, когда последнее обновление 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

Ответ 2

Если вы счастливы использовать 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")

Динамически можно изменить свою ссылку, чтобы она вернула строку. Теперь создайте новый модуль и вставьте следующее:

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, если это помогает.