Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос вставки гиперссылки на текст в ячейке
 
Здравствуйте!
Когда-то давно в сети нашел макрос вставки гиперссылки в ячейку
Цитата
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
 
Код
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
 
МатросНаЗебре, Огромное спасибо! Всё работает!
Страницы: 1
Читают тему (гостей: 1)
Наверх