Макрос вставки гиперссылки на текст в ячейке

Пользователь

Сообщений: 92 Регистрация: 01.01.1970

19.12.2019 10:02:50

Здравствуйте!
Когда-то давно в сети нашел макрос вставки гиперссылки в ячейку

Цитата

Function GetFilePath(Optional ByVal Title As String = "Выберите файл Контракта", _
Optional ByVal InitialPath As String = "C:\", _
Optional ByVal FilterDescription As String = "Документы Adobe", _
Optional ByVal FilterExtention As String = "*.pdf*") As String
' функция выводит диалоговое окно выбора файла с заголовком Title,
' начиная обзор диска с папки InitialPath
' возвращает полный путь к выбранному файлу, или пустую строку в случае отказа от выбора
' для фильтра можно указать описание и расширение выбираемых файлов
On Error Resume Next
With Application.FileDialog(msoFileDialogOpen)
.ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
.Filters.Clear: .Filters.Add FilterDescription, FilterExtention
If .Show <> -1 Then Exit Function
GetFilePath = .SelectedItems(1): PS = Application.PathSeparator
End With
End Function

Private Sub ФГиперссылка_на_файл()
ИмяФайла = GetFilePath ' запрашиваем имя файла
If ИмяФайла = Empty Then
Cont = Application.InputBox("Введите номер Контракта")
If Cont Then Selection.Value = Cont
Else
Selection.Value = Replace(Replace( _
"=HYPERLINK(""ИмяФ"",""№конт"")" _
, "ИмяФ", ИмяФайла) _
, "№конт", Application.InputBox("Введите номер Контракта"))
End If
End Sub

Данный макрос позволяет выдать окно выбора файла, после чего выдает окно ввода текста в ячейку, на который будет установлена гиперссылка на выбранный ранее файл.
Отличный макрос, респект его автору.
Я успешно использовал данный макрос до тех пор, пока номера контрактов содержали только цифры.
При необходимости ввести просто текст без гиперссылки, просто нажимаю отмену выбора файла и в следующем окне пишу текст.

При попытке ввести номер договора, содержащий буквы или символы, выдает ошибку Run-time error '13' Type mismatch и при нажатии на дебаг выделяет слова

Цитата
If Cont Then

Подскажите, что не так с этой строкой? Как сделать, чтобы можно было вводить не только цифры, но и текст типа 123-АБ/233-19

МатросНаЗебре

Пользователь

Сообщений: 6480 Регистрация: 05.02.2014

19.12.2019 10:10:24

Код

Private Sub ФГиперссылка_на_файл()
    ИмяФайла = GetFilePath ' запрашиваем имя файла
   If ИмяФайла = Empty Then
        Dim Cont As Variant
        Cont = Application.InputBox("Введите номер Контракта")
        Select Case Cont
        Case False
        Case Else: Selection.Value = Cont
        End Select
        
    Else
        Selection.Value = Replace(Replace( _
                            "=HYPERLINK(""ИмяФ"",""№конт"")" _
                            , "ИмяФ", ИмяФайла) _
                            , "№конт", Application.InputBox("Введите номер Контракта"))
    End If
End Sub

Александр Иванов Пользователь Сообщений: 92 Регистрация: 01.01.1970	#3 19.12.2019 10:24:21 МатросНаЗебре, Огромное спасибо! Всё работает!