Доброго времени суток, подскажите как можно протянуть гиперссылки на папки чтобы не забивать каждую вручную. Допустим есть столбец с ячейками по порядку 1,2,3 и так далее. Каждой ячейке нужно присвоить гипессылку на соответствующие папки пкеп-454, шрац-234, йцу-758 (примерно такие названия папок), все папки находятся по одному пути на диске компьютера. Сейчас я делаю просто вручную каждой ячейке присваиваю гиперссылку, можно ли как то протянуть, допустим в 1 ячейку сделал гиперссылку протянул и в остальных также появились ссылки на соответствующие папки. У меня Excell 2010, никаких дополнительных надстроек нет и не получится установить.
Доброго времени суток, подскажите как можно протянуть гиперссылки на папки чтобы не забивать каждую вручную. Допустим есть столбец с ячейками по порядку 1,2,3 и так далее. Каждой ячейке нужно присвоить гипессылку на соответствующие папки пкеп-454, шрац-234, йцу-758 (примерно такие названия папок), все папки находятся по одному пути на диске компьютера. Сейчас я делаю просто вручную каждой ячейке присваиваю гиперссылку, можно ли как то протянуть, допустим в 1 ячейку сделал гиперссылку протянул и в остальных также появились ссылки на соответствующие папки. У меня Excell 2010, никаких дополнительных надстроек нет и не получится установить.goodguytomtomtom
Sub u_721() Application.ScreenUpdating = False u = "D:\MY" Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(u) Set fc = f.SubFolders i = 0 For Each f1 In fc ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, "a"), Address:=f1, TextToDisplay:=f1.Name i = i + 1 Next Application.ScreenUpdating = True End Sub
[/vba]
[vba]
Код
Sub u_721() Application.ScreenUpdating = False u = "D:\MY" Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(u) Set fc = f.SubFolders i = 0 For Each f1 In fc ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, "a"), Address:=f1, TextToDisplay:=f1.Name i = i + 1 Next Application.ScreenUpdating = True End Sub
Nic70y, спасибо, я этот код вставил в макрос и прогнал, получается он вставил мне ссылки на все папки из указанного пути в ячейку A1, вопрос как сделать так чтобы он вставлял в ячейку на выбор, например чтобы начал вставлять с ячейки А25 и еще как сделать чтобы он вставлял не все папки которые по данному пути лежат а определенные но по порядку (допустим начиная с 20 папки и до 45).
Nic70y, спасибо, я этот код вставил в макрос и прогнал, получается он вставил мне ссылки на все папки из указанного пути в ячейку A1, вопрос как сделать так чтобы он вставлял в ячейку на выбор, например чтобы начал вставлять с ячейки А25 и еще как сделать чтобы он вставлял не все папки которые по данному пути лежат а определенные но по порядку (допустим начиная с 20 папки и до 45).goodguytomtomtom
Nic70y, разобрался с ячейкой, это зависит от параметра i, не разобрался как выбрать нужный диапазон папок и еще как то можно чтобы вставлялись не названия папок в ячекй а определенные числа по порядку, например 1000, 1001, 1002 и т.д.
Nic70y, разобрался с ячейкой, это зависит от параметра i, не разобрался как выбрать нужный диапазон папок и еще как то можно чтобы вставлялись не названия папок в ячекй а определенные числа по порядку, например 1000, 1001, 1002 и т.д.goodguytomtomtom
, если они числами обозваны, то условие можно вставить в цикл типа [vba]
Код
if val(f1.Name)>=20 and val(f1.Name) <46 then ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, "a"), Address:=f1, TextToDisplay:=1000+i i = i + 1 end if
, если они числами обозваны, то условие можно вставить в цикл типа [vba]
Код
if val(f1.Name)>=20 and val(f1.Name) <46 then ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, "a"), Address:=f1, TextToDisplay:=1000+i i = i + 1 end if
Sub u_721() Application.ScreenUpdating = False u = "D:\MY" Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(u) Set fc = f.SubFolders i = 0 x = 1 For Each f1 In fc If x >= 20 And x <= 40 Then s = "'" & 1000 + i ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, "a"), Address:=f1, TextToDisplay:=s i = i + 1 End If x = x + 1 Next Application.ScreenUpdating = True End Sub
[/vba]
[vba]
Код
Sub u_721() Application.ScreenUpdating = False u = "D:\MY" Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(u) Set fc = f.SubFolders i = 0 x = 1 For Each f1 In fc If x >= 20 And x <= 40 Then s = "'" & 1000 + i ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, "a"), Address:=f1, TextToDisplay:=s i = i + 1 End If x = x + 1 Next Application.ScreenUpdating = True End Sub
bigor, Nic70y, спасибо вроде работает, только не понятно как берется параметр Х, допустим нужная папка, в сортировке по имени на диске, идет под номером 835, а в макрос я вставляю If x >= 812 And x <= 842 Then, тогда он мне ставит в первую ячейку нужную мне папку (та что 835 по счету на диске лежит) не понятно почему нужно ставить 812 а не 835, если что имя моих папок такие ПЭ-1187722, ПЭ-1187822, ПЭ-1187922, ПЭ-1188022 и так далее по порядку
bigor, Nic70y, спасибо вроде работает, только не понятно как берется параметр Х, допустим нужная папка, в сортировке по имени на диске, идет под номером 835, а в макрос я вставляю If x >= 812 And x <= 842 Then, тогда он мне ставит в первую ячейку нужную мне папку (та что 835 по счету на диске лежит) не понятно почему нужно ставить 812 а не 835, если что имя моих папок такие ПЭ-1187722, ПЭ-1187822, ПЭ-1187922, ПЭ-1188022 и так далее по порядкуgoodguytomtomtom
Сообщение отредактировал goodguytomtomtom - Четверг, 06.10.2022, 14:07
Если имена папок как Вы описали, то вариант отслеживания по имени более практичен, только нужно брать не полное имя, а первые 5 цифр. Для папок ПЭ-1183522 до ПЭ-1185522
[vba]
Код
Sub u_721() Application.ScreenUpdating = False u = "D:\MY" Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(u) Set fc = f.SubFolders i = 0 For Each f1 In fc If val(mid(f1.Name,4,5)) >= 11835 And val(mid(f1.Name,4,5)) <= 11855 Then s = "'" & 1000 + i ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, "a"), Address:=f1, TextToDisplay:=s i = i + 1 End If Next Application.ScreenUpdating = True End Sub
[/vba]
Если имена папок как Вы описали, то вариант отслеживания по имени более практичен, только нужно брать не полное имя, а первые 5 цифр. Для папок ПЭ-1183522 до ПЭ-1185522
[vba]
Код
Sub u_721() Application.ScreenUpdating = False u = "D:\MY" Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(u) Set fc = f.SubFolders i = 0 For Each f1 In fc If val(mid(f1.Name,4,5)) >= 11835 And val(mid(f1.Name,4,5)) <= 11855 Then s = "'" & 1000 + i ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, "a"), Address:=f1, TextToDisplay:=s i = i + 1 End If Next Application.ScreenUpdating = True End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
