Страницы: 1
RSS
В выделенную ячейку вставлять гиперссылку на файл из нужной папки
 
Привет!

Нашёл здесь более-менее подходящий макрос, немного подредактровал под свои нужды. Но макрос открывает папку, где лежит данная книга Excel, а надо совсем другую папку. Операция регулярная, поэтому нужно автоматизировать.

Надо, чтобы в выделенную ячейку вставлялась гиперссылка на файл из нужной папки. Файл из этой папки пользователь выбирает сам.

Код
Sub Link()
    Dim s
    s = Application.GetOpenFilename("Files (*.msg*), *.msg*")
    If s <> False Then
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
        Address:=s, _
        TextToDisplay:="x"
        
    End If
End Sub
 
Александр, воспользуйтесь функцией
Код
Application.FileDialog(msoFileDialogFilePicker)
У нее есть параметр InitialFileName, который позволяет открывать указанную вами папку
 
Туговато у меня с VBA в принципе.
Максимум, что у меня получилось - при каждом использовании макроса по очереди выскакивает два диалога - выбора папки (без отображения файлов), а потом файла.

Код
Sub ShowFolderDialog()

Dim s
Dim oFD As FileDialog
    Dim x, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
    With oFD 'используем короткое обращение к объекту
        .InitialFileName = "c:\Users\Adm\_POP1\2\" '"назначаем первую папку отображения
        .InitialView = msoFileDialogViewSmallIcons 'вид диалогового окна(доступно 9 вариантов)
    If oFD.Show = 0 Then Exit Sub 'показывает диалог
    
s = Application.GetOpenFilename("Files (*.msg*), *.msg*")
If s <> False Then
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
        Address:=s, _
        TextToDisplay:="x"
    End If
    End With
End Sub
Изменено: Александр - 04.06.2020 19:26:49
 
Код
Sub ShowFolderDialog()

    Dim s
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "c:\Users\Adm\_POP1\2\"    '"назначаем первую папку отображения
        .InitialFileName = "D:\!AS\"
        .InitialView = msoFileDialogViewSmallIcons    'вид диалогового окна(доступно 9 вариантов)
        If .Show = 0 Then Exit Sub    'показывает диалог
        s = .SelectedItems(1)
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
                                   Address:=s, _
                                   TextToDisplay:="x"
    End With
End Sub
 
RAN, Спасибо огромное!
Страницы: 1
Наверх