Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос вставки в текущую ячейку ссылки на файл
 
Есть кнопка, к которой привязывается макрос. При нажатии на кнопку нужно чтобы открывался диалог вставки гиперссылки на файл (из папки где находится исходный файл) в текущую ячейку
Как сделать?
Спасибо :)
 
Ловите решение, тестируйте. В прикрепленном файла также есть код.
Диалог с пользователем специально выведен в отдельную функцию с целью использования ее в других задачах.
Код
Option Explicit

Sub OpenDialog()
''' Процедура формировани гиперссылки на файл
Dim strAddres As String
strAddres = fnGetOpenFilename
If Len(strAddres) > 0 Then
''' Загрузка выполняется в текущую книгу листа1 ячейки А2
  With ThisWorkbook
    With .Sheets("Лист1")
        .Range("A2") = "=HYPERLINK(" & Chr(34) & strAddres & Chr(34) & "," & Chr(34) & strAddres & Chr(34) & ")"
    End With
  End With
End If
End Sub

Public Function fnGetOpenFilename(Optional sTitle As String = "Выбор файла для формирования гиперссылки", _
                                  Optional MultiSelectFiles As Boolean = False)
''' Функция диалога с пользователем выбора файла _
 по умолчанию выбор любого формата файла, выбор только одного файла
  fnGetOpenFilename = Application.GetOpenFilename _
                  ("Любые файлы (*.*),*.*", , sTitle, , MultiSelectFiles)
End Function
Изменено: TSN - 26 Май 2017 13:16:53
 
Спасибо!
Изменено: Sege - 26 Май 2017 13:19:00
 
Вставляет только в конкретную ячейку. Можно чтобы ссылка вставлялась в ТЕКУЩУЮ активную ячейку?
 
Цитата
Sege написал:
Можно чтобы ссылка вставлялась в ТЕКУЩУЮ активную ячейку?
Измените процедуру на такую, будет вставлять в выделенную ячейку а также в выделенные ячейки
Код
Sub OpenDialog()
''' Процедура формировани гиперссылки на файл
Dim strAddres As String, Vl
strAddres = fnOpenTextFile
If Len(strAddres) > 0 Then
    For Each Vl In Selection  
      Vl.Value = "=HYPERLINK(" & Chr(34) & strAddres & Chr(34) & "," & Chr(34) & strAddres & Chr(34) & ")"
    Next
End If
End Sub
Изменено: TSN - 26 Май 2017 13:44:34
 
еще вариант с реализацией
Цитата
Sege написал:
(из папки где находится исходный файл)
Код
Dim oFD As FileDialog
'назначаем переменной ссылку на экземпляр диалога
Set oFD = Application.FileDialog(msoFileDialogFilePicker)
With oFD 'используем короткое обращение к объекту
        .AllowMultiSelect = False 'разрешаем выбор только одного файла
        .Title = "Выбрать файл" 'заголовок окна диалога
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .Filters.Add "All files", "*.*"
        .InitialFileName = ActiveWorkbook.Path 'назначаем папку отображения и имя файла по умолчанию
        .InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
        If oFD.Show = 0 Then Exit Sub 'показывает диалог
End With
txt = Split(oFD.SelectedItems(1), "\")
ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=oFD.SelectedItems(1), TextToDisplay:=txt(UBound(txt))
 
Спасибо, заработало!
Страницы: 1
Читают тему (гостей: 2)
Наверх