Проблемы с циклическим переходом по листам - PullRequest
0 голосов
/ 24 июня 2019

Я пытаюсь перебрать некоторые листы в рабочей книге, чтобы обновить гиперссылку в столбце А, но продолжаю сталкиваться с различными проблемами, которые не могу понять.

Private Sub Workbook_Open()

    Dim HL As Hyperlink
    Dim lnk As String 'actual link
    Dim ori As String 'old link
    Dim nvr As String
    Dim forn As String 'hyperlink name
    Dim ws As Worksheet

    nvr = ThisWorkbook.Path 'new path
    ori = Sheets("check list e parametri").Range("a28").Value 'old path

    For Each ws In ThisWorkbook.Worksheets
        Select Case ws.Name
            Case "Fatture consegnate 2019", "Progress", "check list e parametri", "Fatture consegnate backup" 'sheets to skip
            Case Else
                With ActiveWorksheet
                .Range("a2:a200").Select
                    For Each HL In Selection.Hyperlinks
                        forn = HL.TextToDisplay
                        lnk = HL.Address 'complete link
                        lnk = Replace(lnk, ori, nvr) 'replace old path with new path
                        ActiveSheet.Hyperlinks.Add Anchor:=HL.Range, Address:=lnk, TextToDisplay:=forn 'new hyperlink with name
                    Next HL
                End With
            End Select
    Next ws

    Sheets("check list e parametri").Range("a28") = nvr 'new path saved for the future

End Sub

Я довольно новичок в VBA, поэтому мои знания ограничены, и мой код ... по крайней мере груб. Я пробовал разные циклические варианты, но код продолжает выдавать ошибки. Я ожидаю, что код будет циклически проходить по всем неисключенным рабочим листам при каждом открытии рабочей книги, определять гиперссылку в выбранном диапазоне, заменять старый путь новым и сохранять то же отображаемое имя. (Я использую Excel 2013)

1 Ответ

1 голос
/ 24 июня 2019

И теперь это работает! Спасибо всем, кто указал мне правильное направление! Код выглядит так:

Private Sub Workbook_Open()

Dim HL As Hyperlink
Dim lnk As String 'link attuale
Dim ori As String 'root vecchia
Dim nvr As String
Dim forn As String 'nome fornitore
Dim ws As Worksheet
Dim rng As Range

nvr = ThisWorkbook.Path 'nuova root
ori = Sheets("check list e parametri").Range("a28").Value 'vecchia root

For Each ws In ThisWorkbook.Worksheets
    Select Case ws.Name
        Case "Fatture consegnate 2019", "Progress", "check list e parametri", "Fatture consegnate backup"
        'salta questi fogli
        Case Else
            Set rng = ws.Range("a2:a200")
                For Each HL In rng.Hyperlinks 'check link
                    forn = HL.TextToDisplay
                    lnk = HL.Address 'link completo
                    lnk = Replace(lnk, ori, nvr)
                    ws.Hyperlinks.Add Anchor:=HL.Range, Address:=lnk, TextToDisplay:=forn 'nuovo hyperlink
                Next HL
    End Select
Next ws

Sheets("check list e parametri").Range("a28") = nvr 'sostituisce vecchia root con nuova


End Sub 

Еще раз спасибо за помощь!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...