Опишу вам кратко мою ситуацию. Есть у меня таблица с документами (название в колонке А) и мне необходимо в колонке (Б) ссылку на файл, который находится на диске. Есть одна особенность, что файлы, которые сохранены на диске могут иметь не точно такое же название, как в таблице. Вручную делать либо через формулу гиперссылки можно, но муторно, и плюс нужно знать точное название файла.
Хотелось бы облегчить процесс следующим образом: Заполняем название документа в таблице, а в колонке рядом создается гиперссылка на файл, который находится на диске. Соответственно макросик сам пойдет сравнивать в папку на диске (в которой могут быть и подпапки), находит файл с почти таким же названием и дает ссылку.
Вот пример таблицы. Работаю в excel 2010, похожий код находила на 2003, но он не пашет в моей версии.
Заранее благодарна!!
Здравствуйте ребята,
Опишу вам кратко мою ситуацию. Есть у меня таблица с документами (название в колонке А) и мне необходимо в колонке (Б) ссылку на файл, который находится на диске. Есть одна особенность, что файлы, которые сохранены на диске могут иметь не точно такое же название, как в таблице. Вручную делать либо через формулу гиперссылки можно, но муторно, и плюс нужно знать точное название файла.
Хотелось бы облегчить процесс следующим образом: Заполняем название документа в таблице, а в колонке рядом создается гиперссылка на файл, который находится на диске. Соответственно макросик сам пойдет сравнивать в папку на диске (в которой могут быть и подпапки), находит файл с почти таким же названием и дает ссылку.
Вот пример таблицы. Работаю в excel 2010, похожий код находила на 2003, но он не пашет в моей версии.
Вот основа, здесь используется папка файла с макросом. [vba]
Код
Public Sub ssil() Dim rng1 As Range, unoCell As Range Dim rowLast As Long Dim TheFolder, TheFiles, AFile, FSO
With ActiveSheet
rowLast = .Cells(Rows.Count, 1).End(xlUp).Row Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1)) Set FSO = CreateObject("Scripting.FileSystemObject") Set TheFolder = FSO.GetFolder(ThisWorkbook.Path) ' папка где лежат все files Set TheFiles = TheFolder.Files For Each unoCell In rng1 For Each AFile In TheFiles If (AFile.Name Like "*" & unoCell.Value & "*.pdf") And (unoCell.Value <> "") Then .Hyperlinks.Add Anchor:=unoCell.Offset(0, 1), _ Address:=TheFolder & "\" & AFile.Name, TextToDisplay:=TheFolder & "\" & AFile.Name End If Next AFile Next unoCell End With End Sub
[/vba]
Вот основа, здесь используется папка файла с макросом. [vba]
Код
Public Sub ssil() Dim rng1 As Range, unoCell As Range Dim rowLast As Long Dim TheFolder, TheFiles, AFile, FSO
With ActiveSheet
rowLast = .Cells(Rows.Count, 1).End(xlUp).Row Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1)) Set FSO = CreateObject("Scripting.FileSystemObject") Set TheFolder = FSO.GetFolder(ThisWorkbook.Path) ' папка где лежат все files Set TheFiles = TheFolder.Files For Each unoCell In rng1 For Each AFile In TheFiles If (AFile.Name Like "*" & unoCell.Value & "*.pdf") And (unoCell.Value <> "") Then .Hyperlinks.Add Anchor:=unoCell.Offset(0, 1), _ Address:=TheFolder & "\" & AFile.Name, TextToDisplay:=TheFolder & "\" & AFile.Name End If Next AFile Next unoCell End With End Sub
В смысле не работает? Алгоритм такой: сравниваются имена файлов указанной папки с ячейками диапазона. Если имена из ячеек совпадают с частью имени файла, то имя файла вписывается в ячейку рядом как гиперссылка. Я у себя на тестовом файле проверил - макрос его выявил.
В смысле не работает? Алгоритм такой: сравниваются имена файлов указанной папки с ячейками диапазона. Если имена из ячеек совпадают с частью имени файла, то имя файла вписывается в ячейку рядом как гиперссылка. Я у себя на тестовом файле проверил - макрос его выявил.
Вы файл запускаете который скачали, или код скопировали в свой и оттуда запускаете? Я прописал обработку активного листа, если лист будет "неправильный" могут быть сюрпризы.
Вы файл запускаете который скачали, или код скопировали в свой и оттуда запускаете? Я прописал обработку активного листа, если лист будет "неправильный" могут быть сюрпризы.Udik
вот вам барабан яд 41001231307558 wm R419131876897 udik1968@gmail.com
В смысле не работает? Алгоритм такой: сравниваются имена файлов указанной папки с ячейками диапазона. Если имена из ячеек совпадают с частью имени файла, то имя файла вписывается в ячейку рядом как гиперссылка. Я у себя на тестовом файле проверил - макрос его выявил.
Гляньте, пожалуйста, мой макрос. Грузится, но ничего не происходит. Ошибок снова не дает.
[vba]
Код
Option Explicit
Public Sub ssil() Dim rng1 As Range, unoCell As Range Dim rowLast As Long Dim TheFolder, TheFiles, AFile, FSO
With ActiveSheet
rowLast = .Cells(Rows.Count, 1).End(xlUp).Row foldername = "С:\Users\AA\Downloads" Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1)) Set FSO = CreateObject("Scripting.FileSystemObject") Set TheFolder = FSO.GetFolder(FolderName) Set TheFiles = TheFolder.Files For Each unoCell In rng1 For Each AFile In TheFiles If AFile.Name Like "*" & unoCell.Value & "*.pdf" Then .Hyperlinks.Add Anchor:=unoCell.Offset(0, 1), _ Address:=TheFolder & "\" & AFile.Name, TextToDisplay:=TheFolder & "\" & AFile.Name End If Next AFile Next unoCell End With End Sub
В смысле не работает? Алгоритм такой: сравниваются имена файлов указанной папки с ячейками диапазона. Если имена из ячеек совпадают с частью имени файла, то имя файла вписывается в ячейку рядом как гиперссылка. Я у себя на тестовом файле проверил - макрос его выявил.
Гляньте, пожалуйста, мой макрос. Грузится, но ничего не происходит. Ошибок снова не дает.
[vba]
Код
Option Explicit
Public Sub ssil() Dim rng1 As Range, unoCell As Range Dim rowLast As Long Dim TheFolder, TheFiles, AFile, FSO
With ActiveSheet
rowLast = .Cells(Rows.Count, 1).End(xlUp).Row foldername = "С:\Users\AA\Downloads" Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1)) Set FSO = CreateObject("Scripting.FileSystemObject") Set TheFolder = FSO.GetFolder(FolderName) Set TheFiles = TheFolder.Files For Each unoCell In rng1 For Each AFile In TheFiles If AFile.Name Like "*" & unoCell.Value & "*.pdf" Then .Hyperlinks.Add Anchor:=unoCell.Offset(0, 1), _ Address:=TheFolder & "\" & AFile.Name, TextToDisplay:=TheFolder & "\" & AFile.Name End If Next AFile Next unoCell End With End Sub
требует обязательного объявления переменных, объявления foldername не нашёл. И второе: foldername и FolderName должны быть одинаково написаны. Обычно автоматически так происходит, если нет, то может какая ошибка имеется.
Сейчас поробую Ваш код у себя проверить. == добавил [vba]
Код
Dim FolderName As String
[/vba] нормально отработало. еще одну строку чуть подправить надо. [vba]
Код
If (AFile.Name Like "*" & unoCell.Value & "*.pdf") And (unoCell.Value <> "") Then
[/vba]
Вот эта строка
Цитата
Option Explicit
требует обязательного объявления переменных, объявления foldername не нашёл. И второе: foldername и FolderName должны быть одинаково написаны. Обычно автоматически так происходит, если нет, то может какая ошибка имеется.
Сейчас поробую Ваш код у себя проверить. == добавил [vba]
Код
Dim FolderName As String
[/vba] нормально отработало. еще одну строку чуть подправить надо. [vba]
Код
If (AFile.Name Like "*" & unoCell.Value & "*.pdf") And (unoCell.Value <> "") Then
Это надо пошагово проверять. Оставьте в папке 1-2 файла и проверьте каждый шаг. Или сделайте архив с папкой и эксель файлом, тогда я у себя смогу проверить.
Это надо пошагово проверять. Оставьте в папке 1-2 файла и проверьте каждый шаг. Или сделайте архив с папкой и эксель файлом, тогда я у себя смогу проверить.Udik
вот вам барабан яд 41001231307558 wm R419131876897 udik1968@gmail.com
Сообщение отредактировал Udik - Среда, 23.11.2016, 18:52
Посмотрел - Вы лишний слеш оставили Надо ''FolderName = "C:\Users\hfm560\Downloads\Downloads.7z\" без конечного слеша. Ваш архивчик проверил - отловился Документ 2. Вроде правильно, остальных имён в именах файлов нет. Чуток подправил код. [vba]
Код
Public Sub ssil() Dim rng1 As Range, unoCell As Range Dim rowLast As Long Dim TheFolder, TheFiles, AFile, FSO Dim FolderName As String
Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1)) Set FSO = CreateObject("Scripting.FileSystemObject") Set TheFolder = FSO.GetFolder(FolderName) Set TheFiles = TheFolder.Files For Each unoCell In rng1 For Each AFile In TheFiles If (AFile.Name Like "*" & unoCell.Value & "*.pdf") And (unoCell.Value <> "") Then .Hyperlinks.Add Anchor:=unoCell.Offset(0, 1), _ Address:=TheFolder.Path & "\" & AFile.Name, TextToDisplay:=TheFolder.Path & "\" & AFile.Name End If Next AFile Next unoCell End With End Sub
[/vba] Если не заработает, значит путь как-то неправильно записан.
Посмотрел - Вы лишний слеш оставили Надо ''FolderName = "C:\Users\hfm560\Downloads\Downloads.7z\" без конечного слеша. Ваш архивчик проверил - отловился Документ 2. Вроде правильно, остальных имён в именах файлов нет. Чуток подправил код. [vba]
Код
Public Sub ssil() Dim rng1 As Range, unoCell As Range Dim rowLast As Long Dim TheFolder, TheFiles, AFile, FSO Dim FolderName As String
Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1)) Set FSO = CreateObject("Scripting.FileSystemObject") Set TheFolder = FSO.GetFolder(FolderName) Set TheFiles = TheFolder.Files For Each unoCell In rng1 For Each AFile In TheFiles If (AFile.Name Like "*" & unoCell.Value & "*.pdf") And (unoCell.Value <> "") Then .Hyperlinks.Add Anchor:=unoCell.Offset(0, 1), _ Address:=TheFolder.Path & "\" & AFile.Name, TextToDisplay:=TheFolder.Path & "\" & AFile.Name End If Next AFile Next unoCell End With End Sub
[/vba] Если не заработает, значит путь как-то неправильно записан. Udik
Посмотрел - Вы лишний слеш оставили Надо ''FolderName = "C:\Users\hfm560\Downloads\Downloads.7z\" без конечного слеша.
Урааа, зарабооотало!!!
А еще вопрос, если название документа не в первой колонке и первой линии, а скажем 7 колонка и 5 линия, а ссылка должна быть в 25 колонке и 5 линии, где мне это указать?
[vba]
Код
Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1)) 'в этой линии кода надо изменить?'
Посмотрел - Вы лишний слеш оставили Надо ''FolderName = "C:\Users\hfm560\Downloads\Downloads.7z\" без конечного слеша.
Урааа, зарабооотало!!!
А еще вопрос, если название документа не в первой колонке и первой линии, а скажем 7 колонка и 5 линия, а ссылка должна быть в 25 колонке и 5 линии, где мне это указать?
[vba]
Код
Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1)) 'в этой линии кода надо изменить?'
Доброго дня. Пользуюсь этим макросом, но в таблице с 500 строк обработка занимает слишком много времени. Строки в таблице добавляются и нет необходимости просматривать огромное количество ранее присвоенных ссылок.
Вопрос: как изменить этот код, что бы поиск происходил не по всей заполненной первой колонке, а по предыдущим 5 строкам от строки с выделенной ячейкой. Например: текущая выделенная ячейка "F128" значит диапазон поиска должен быть - А124:А128
Доброго дня. Пользуюсь этим макросом, но в таблице с 500 строк обработка занимает слишком много времени. Строки в таблице добавляются и нет необходимости просматривать огромное количество ранее присвоенных ссылок.
Вопрос: как изменить этот код, что бы поиск происходил не по всей заполненной первой колонке, а по предыдущим 5 строкам от строки с выделенной ячейкой. Например: текущая выделенная ячейка "F128" значит диапазон поиска должен быть - А124:А128Литр
Пытался, но что то пошло не так.... Иксель зациклился и перестал отвечать )))) Дальше побоялся экспериментировать что бы не обрушить полностью Office Литр
Сообщение отредактировал Литр - Вторник, 09.12.2025, 12:32
Осталось только заставить его работать в книге с общим доступом. Не могу найти на форуме, было ли обсуждение темы об ограничениях макросов в таких книгах и как это решить?
_Boroda_,
Осталось только заставить его работать в книге с общим доступом. Не могу найти на форуме, было ли обсуждение темы об ограничениях макросов в таких книгах и как это решить?Литр
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
