Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: Пред. 1 2
RSS
как изменить расположение гипперсылок если произошел сбой?, изменение расположения гипперсылок
 
Ну вот у меня почему-то заменилось все...Попробуйте код, который я привел выше - все работает. Правда, у Вас не во всех ячейках такие пути. В AQ6, например, совсем что-то другое...
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Кнопка цитирования не для ответа [МОДЕРАТОР]

да, там есть измененные,  я в курсе..... спасибо большое я разобрался, почему не меняет,
нельзя оставлять активным ячейку иначе не работает, нужно увести перед запуском от ячеек активность
 
Кнопка цитирования не для ответа [МОДЕРАТОР]

Дмитрий(The_Prist) Щербаков, еще раз здравствуйте, траблы продолжаются, в разных гиперссылках в путях сфлэши в разные стороны определяются  "\"   "/" и кол-во  /AppData/Roaming/ где то по 3 а где то по 4, вопрос можно ли прописать, чтобы находил и исправлял пути с флэшами в разные стороны и /AppData/Roaming/ исправлял  с 3  и с 4 повторами ?
 
Попробуйте такой код:
Код
Sub Replace_Hyperlink()
    Dim rCell As Range, rRange As Range, sWhatRep As String, sRep As String
    Dim lp As Long
    
    On Error Resume Next
    Set rRange = Application.InputBox("Укажите диапазон для замены", "Выбор данных", Type:=8)
    If rRange Is Nothing Then Exit Sub
    sRep = "C:\Users\Derek\Desktop\ВРОЖАЙ 2018\фото\Жовтнева СР\"
    Application.ScreenUpdating = 0
    For Each rCell In rRange
        If rCell.Hyperlinks.Count > 0 Then
            If rCell.Hyperlinks(1).Address = rCell.Value Then
                rCell = Replace(rCell.Value, sWhatRep, sRep)
            End If
            If rCell.Hyperlinks(1).Address <> "" Then
                sWhatRep = rCell.Hyperlinks(1).Address
            End If
            If rCell.Hyperlinks(1).SubAddress <> "" Then
                sWhatRep = rCell.Hyperlinks(1).SubAddress
            End If
            'определяем имя файла без пути
            lp = InStrRev(sWhatRep, "/")
            If lp = 0 Then
                lp = InStrRev(sWhatRep, "\")
            End If
            If lp > 0 Then
                sWhatRep = Mid(sWhatRep, lp + 1, Len(sWhatRep) - lp)
                If rCell.Hyperlinks(1).Address <> "" Then
                    rCell.Hyperlinks(1).Address = sRep & sWhatRep
                End If
                If rCell.Hyperlinks(1).SubAddress <> "" Then
                    rCell.Hyperlinks(1).SubAddress = sRep & sWhatRep
                End If
            End If
        End If
    Next rCell
    Application.ScreenUpdating = 1
End Sub
при необходимости измените путь в sRep. Код заменит все пути к картинкам на новый независимо от того, что там было ранее. Названия картинок сохраняются.

P.S. И не надо писать мне с просьбами и проблемами - если мне интересно, я загляну без дополнительных напоминаний и просьб. А если неинтересно - не загляну в любом случае. Спасибо.
Изменено: Дмитрий(The_Prist) Щербаков - 11 Сен 2018 10:04:00
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
Попробуйте такой код:
Дмитрий большое спасибо, заработало )
но есть момент, в данной таблице имеются гиперссылки  в которых указываются одинаковые пути но папки разные "Жовтнева СР",  "Долинська СР" и тд...
если я применю (а их более 24 000 ячеек с гиперссылками) к определенной колонке где гиперссылки то данный макрос все гиперссылки пропишет пути в папку "Жовтнева СР", а как сделать так чтобы он мог определять и другие гиперссылки в пути (к примеру "Долинська СР") не менял ?
иначе он все исправит в одну папку....  
 
Как сделать в случае с разными папками - это ручками каждый конкретный путь менять. Пока неясно насколько пути изменяются - то ли последняя папка, то ли они все могут быть вообще вразнобой.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
он меняет любые пути только не меняет конечное имя файла ,
24000 не реально ручками  )
может можно что то придумать к примеру
задать ему условие, если в пути имеется  к примеру "Жовнева СР" тогда правим
если нет тогда не правим
и вот тут я тогда ручками смогу поправить ( к примеру "Жовнева СР", на  "Кіровська СР" ) условие и будет быстрее )
можно так сделать ?
Изменено: denya83 - 11 Сен 2018 11:22:35
 
Вы бы лучше сразу описали что за условия должны быть, в каких местах папки могут менять, а где нет и т.п. А прописать чтобы не менял, если есть "Жовнева СР" - без проблем. Добавляете условие. Вместо этого блока:
Код
'определяем имя файла без пути
            lp = InStrRev(sWhatRep, "/")
            If lp = 0 Then
                lp = InStrRev(sWhatRep, "\")
            End If
            If lp > 0 Then
                sWhatRep = Mid(sWhatRep, lp + 1, Len(sWhatRep) - lp)
                If rCell.Hyperlinks(1).Address <> "" Then
                    rCell.Hyperlinks(1).Address = sRep & sWhatRep
                End If
                If rCell.Hyperlinks(1).SubAddress <> "" Then
                    rCell.Hyperlinks(1).SubAddress = sRep & sWhatRep
                End If
            End If
записываете такой:
Код
If sWhatRep like "*Жовнева СР*" then
'определяем имя файла без пути
            lp = InStrRev(sWhatRep, "/")
            If lp = 0 Then
                lp = InStrRev(sWhatRep, "\")
            End If
            If lp > 0 Then
                sWhatRep = Mid(sWhatRep, lp + 1, Len(sWhatRep) - lp)
                If rCell.Hyperlinks(1).Address <> "" Then
                    rCell.Hyperlinks(1).Address = sRep & sWhatRep
                End If
                If rCell.Hyperlinks(1).SubAddress <> "" Then
                    rCell.Hyperlinks(1).SubAddress = sRep & sWhatRep
                End If
            End If
end if
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Теперь пишет ошибку , скрин прилагаю  
Screenshot_4.jpg (125.46 КБ)
 
Какой-то макрос сейчас выполняется, видимо. Надо нажать на панели синий квадратик и запустить код заново.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
теперь пишет следующее  
Screenshot_6.jpg (119.18 КБ)
 
Цитата
denya83 написал:
теперь пишет следующее  
наверное, надо было корректно замену делать, а не заменять все от той строки и до конца. Я указал конкретный блок, который надо заменить. Вы зачем-то заменили все, захватив при этом лишнего. Внимательно посмотрите какой блок я указал для замены и заменит ТОЛЬКО ЕГО, а не все, что еще и после него идет.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
да действительно внизу захватил лишнее, все исправил ,
большое спасибо Дмитрий за проделанную работу !!!!!!!!!!!!!!!!! )))))
Страницы: Пред. 1 2
Читают тему (гостей: 3)
Наверх