Возникли проблемы с получением VBA для редактирования существующих гиперссылок

Question

Итак, я запускаю макрос, который архивирует журнал учета в папку архива, после того, как он заархивирован, макрос очищает столбец на нескольких листах, чтобы очистить журнал учета.По какой-то причине, когда я впервые запустил этот макрос, все работало нормально, но все гиперссылки, которые были связаны с папкой на сервере, были повреждены.Последние 2 папки верны, но все предыдущие папки стали "../../../../../", когда я нажимал на Редактировать гиперссылку.Так что это выглядело как "../../../../../Clients/ClientA/".В архивном файле есть то же «../../», но ссылки работают.

При нажатии на ссылку мне было выдано следующее сообщение об ошибке: «Не удается открыть указанный файл».Но когда я редактирую файл и помещаю имена папок вместо "../", тогда он работает нормально.Я не уверен, почему это происходит.Но независимо от того, что каждая гиперссылка есть на каждом листе в ячейке G1.Поэтому я написал макрос для исправления ссылок.

  Sub hyperUpdate()
  Dim wsHyper As Worksheet, addr As String, lastrow As Long, h As Hyperlink

  lastrow = Worksheets("Auto Archive").Range("A" & Worksheets("Auto 
  Archive").Rows.Count).End(xlUp).Row

  For i = 2 To lastrow

  Set wsHyper = Worksheets(Worksheets("Auto Archive").Cells(i, 1).Value)
  wsHyper.Activate
  addr = Worksheets("Auto Archive").Cells(i, 3).Value
  wsHyper.Cells(1, 7).Activate


  Application.ActiveCell.Hyperlinks(1).Address = addr
  MsgBox Application.ActiveCell.Hyperlinks(1).Address

  Next i

  End Sub

Итак, в окне сообщения каждый раз указывается правильный адрес, но когда я нажимаю на редактировать гиперссылку, я получаю одно и то же "../../" иссылка все еще не работает.Что может быть лучше?Спасибо

Answer 1

Чтобы избежать гиперссылок - сохраните путь к файлу в ячейке (вместо гиперссылки)

Тогда что-то вроде следующего в процедуре sheet.selectionchange

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   Dim MinValidRow as long, MaxValidRow as Long, LinkedCol as long

   MinValidRow = 5 ' You Set this to whatever you want
   MaxValidRow = 9 ' You Set this to whatever you want
   LinkedCol   = 2 ' You Set this to whatever you want

   If Sh.Name = "YourSheet" then
      If Target.Column = LinkedCol and Target.Row > MinValidRow and Target.Row<MaxValidrow then
         CreateObject("Shell.Application").Open(Target.Text)
      End If
   End If
End Sub

Вам также следует отойти от выбранной ячейки, чтобы ее можно было выбрать снова, щелкнув по ней, и, возможно, вы захотите запретить кому-либо запускать множество файлов, нажав и удерживая стрелку вниз