Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Microsoft Office (Word, Excel, Outlook и т.д.) (http://forum.oszone.net/forumdisplay.php?f=115)
-   -   Изменение пути гиперссылок Excel2010 (http://forum.oszone.net/showthread.php?t=320297)

oleg_nojab 31-10-2016 08:55 2683226
Изменение пути гиперссылок Excel2010
 
Добрый день уважаемые форумчане!
Проблема в следующем, имеется файлик Excel с множеством гиперссылок которые ссылаются на файлы в папке (\\10.52.1.1\Стройки\Проекты), возникла острая необходимость подпапку "Проекты" вытащить из папки "Стройки" и поместить в корень (\\10.52.1.1\Проекты), помогите с написанием скрипта по изменению гиперссылок во всем документе. Просьба не отправлять в гугл и прочие форумы, все что было найдено в сети, не сработало. Заранее спасибо за помощь.

a_axe 31-10-2016 09:30 2683235
oleg_nojab, попробуйте код ниже. Код заменит ссылки на одном активном листе.
Предварительно сделайте резервную копию вашей книги, во избежание потери данных.
Код
Код:
Public Sub HL_repl()
    Dim HLobj As Hyperlink
    For Each HLobj In ActiveSheet.Hyperlinks
        HLobj.Address = Replace(HLobj.Address, "\\10.52.1.1\Стройки\Проекты", "\\10.52.1.1\Проекты")
    Next HLobj
End Sub

Iska 31-10-2016 09:39 2683241
На WSH (не проверялось):
Код:
Option Explicit

Const xlPart = 2

Dim objWorkSheet


With WScript.CreateObject("Excel.Application")
        With .Workbooks.Open("C:\Мои проекты\0023\Книга1.xls")
                .Parent.DisplayAlerts = False
               
                For Each objWorkSheet In .Worksheets
                        objWorkSheet.UsedRange.Replace "\\10.52.1.1\Стройки\Проекты", "\\10.52.1.1\Проекты", xlPart
                Next
               
                .Parent.DisplayAlerts = True
               
                .Save
                .Close
        End With
       
        .Quit
End With

WScript.Quit 0

oleg_nojab 31-10-2016 11:55 2683301
Цитата:
Цитата a_axe
Public Sub HL_repl()
Dim HLobj As Hyperlink
For Each HLobj In ActiveSheet.Hyperlinks
HLobj.Address = Replace(HLobj.Address, "\\10.52.1.1\Стройки\Проекты", "\\10.52.1.1\Проекты")
Next HLobj
End Sub »
Выдает ошибку "Run-time error 13: Type mismatch"

Iska 31-10-2016 13:02 2683323
Цитата:
Цитата oleg_nojab
Выдает ошибку "Run-time error 13: Type mismatch" »
Покажите скриншот вместе с данным кодом в окне редактора VBA. Было бы неплохо также приложить образец Рабочей книги с гиперссылками, упаковав его в архив.

a_axe 31-10-2016 14:36 2683355
Цитата:
Цитата Iska
На WSH (не проверялось): »
Iska, это в редакторе VBA нужно запускать? Не то чтобы я что-нибудь понял, просто хоть понять, в какую сторону идти...

Iska 31-10-2016 17:33 2683410
Цитата:
Цитата a_axe
Iska, это в редакторе VBA нужно запускать? »
Нет. Сохранить в файл с расширением .vbs и запустить двойным щелчком из Проводника (хост WScript.exe). Я лично предпочитаю консоль Far Manager'а, посему у меня по умолчанию («CScript.exe //H:CScript») используется консольный хост CScript.

Ваш код, кстати, как я полагаю, более правильный.

oleg_nojab 01-11-2016 07:46 2683610
Вложений: 1
Пробую на тестовом файле, ошибка сохраняетсяФайл 140970

Iska 01-11-2016 08:14 2683614
oleg_nojab, к сожалению, не видно место возникновения ошибки. Упакуйте Ваш тестовый файл в архив и приложите к сообщению, либо выложите на RGhost или Яндекс.Диск.

oleg_nojab 02-11-2016 07:15 2683891
Вложений: 1
Всем спасибо, проблема решена, скрипт взят с сайта www.vba-excel.ru
Файл 140998

Iska 02-11-2016 07:54 2683902
«On Error Resume Next» надо выкинуть (и вообще забыть его использование подобным образом как страшный сон). Перед InputBox проверять наличие выделения (более одной ячейки) и использовать его в качестве умолчания. Остальное, в принципе, сойдёт.


Время: 22:28.

Время: 22:28.
© OSzone.net 2001-