Блог

Приведенный ниже VBA позволяет пользователю выбрать папку, после чего полные пути отображаются в столбце 1 активного листа.

Как бы мне изменить это, чтобы эти пути работали как гиперссылки?

 Option Explicit
Sub cmdList()
    Dim sPath   As String
    Dim fOut    As Variant
    Dim r       As Integer
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select directory"
        .InitialFileName = ThisWorkbook.Path amp; ""
        .AllowMultiSelect = False
        If .Show = 0 Then Exit Sub
        sPath = .SelectedItems(1)
    End With
    fOut = Split(CreateObject("WScript.Shell").exec("cmd /c dir """ amp; sPath amp; """ /a:-h-s /b /s").StdOut.ReadAll, vbNewLine)
    r = 5
    Range(r amp; ":" amp; Rows.Count).Delete
   Cells(r, 1).Resize(UBound(fOut)   1, 1).Value = WorksheetFunction.Transpose(fOut)
End Sub
  

Спасибо!

Поскольку ваш код уже получает полную спецификацию файла, мы можем использовать данные для завершения =HYPERLINK() формул:

 Sub cmdList()
    Dim sPath   As String
    Dim fOut    As Variant
    Dim r       As Integer

    Dim Cell As Range

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select directory"
        .InitialFileName = ThisWorkbook.Path amp; ""
        .AllowMultiSelect = False
        If .Show = 0 Then Exit Sub
        sPath = .SelectedItems(1)
    End With
    fOut = Split(CreateObject("WScript.Shell").exec("cmd /c dir """ amp; sPath amp; """ /a:-h-s /b /s").StdOut.ReadAll, vbNewLine)
    r = 5
    Range(r amp; ":" amp; Rows.Count).Delete
   Cells(r, 1).Resize(UBound(fOut)   1, 1).Value = WorksheetFunction.Transpose(fOut)

   '*************************************************************

   Dim dq As String,  rng As Range
   dq = Chr(34)

   Set Rng = Cells(r, 1).Resize(UBound(fOut)   1, 1)
   For Each Cell In Rng
        Cell.Formula = "=HYPERLINK(" amp; dq amp; Cell.Value amp; dq amp; "," amp; dq amp; Cell.Value amp; dq amp; ")"
   Next Cell

End Sub
  

добавьте код над синтаксисом «End sub». Следующий код изменит значение Activecell на hyperlink

Активная таблица.Гиперссылки.Добавьте Activecell, Activecell.Значение

Я надеюсь, что это полезно для вас.