Другие языки программирования и технологии

Создание множества гиперссылок в эксель

Есть таблица с кучей имен файлов (без расширений) и есть папка в которой эти самые файлы находятся, Подскажите пожалуйста макрос, который бы заменил в таблице имена файлов на гиперссылки на них.
Эксель прошлогодний.
'-- Вариант 1 из указанного диапазона макрос пытается найти в указанной папке файл,
' если находит - меняет на ссылку, если нет - помечает ячейку цветом
' совпадение имен при разных расширениях на Вашей совести - иначе не сделать

'Папка с файлами, \ в конце обязателен
Const strFolder As String = "C:\"
'Лист и диапазон в таблице, где будет поиск-замена
Const strRange As String = "Лист1!A1:A10"
'Цвет выделения
Const intColor As Long = 65535

Dim strFile As String
Dim objRange As Range
Dim objCell As Range

Set objRange = Application.Range(strRange)

For Each objCell In objRange.Cells
'Пропускаем ячейки, если это уже гиперссылка. Уберите If и End If, если не нужно
If objCell.Hyperlinks.Count = 0 Then
strFile = Dir(strFolder & objCell.Value & ".*")
If strFile <> "" Then
objCell.Hyperlinks.Add objCell, strFolder + strFile
Else
objCell.Interior.Color = intColor
End If
End If
Next

'-- Вариант 2 (все файлы из указанной папки вставляются как ссылки
' в указанную колонку, начиная с указанной ячейки)
'Папка с файлами, \ в конце обязателен
Const strFolder As String = "C:\"
'Первая ячейка в колонке куда будут вставлятся ссылки
Const strCell As String = "Лист1!A1"

Dim strFile As String
Dim objRange As Range

Set objRange = Application.Range(strCell)

strFile = Dir(strFolder)
Do While strFile <> ""
objRange.Hyperlinks.Add objRange, strFolder + strFile
Set objRange = objRange.Offset(1, 0)
strFile = Dir
Loop
Игорь Крывой
Игорь Крывой
84 764
Лучший ответ