Eliminar hiperligações de um Workbook ou de um documento do Word

Este post faz parte de uma série de pedidos de ajuda que ao longo dos anos me foram chegando.

Dúvida: “Tenho um Workbook que tem bastantes hiperligações, e eu queria eliminar essas ligações mas deixar o texto, só desactivá-las, deve haver alguma maneira de fazer isso rapidamente sem ser um a um, porque no meu caso são algumas centenas. Já agora tenho o mesmo problema no word. ”

Solução: Macro detecta a quantidade de hiperligações existentes no workbook activo e elimina a ligação de todas, adicionado também outra macro para ser usado no Word.

Antes:
Excel hiperligações

Depois:
Excel hiperligacoes

Macro para utilizar no Microsoft Excel

'--------------------------------------------------
' www.jjoao.com
'--------------------------------------------------
Sub EliminarHyperlinksExcel()
   Dim sh As Worksheet, link As Hyperlink, x As Long, t As Long
   On Error Resume Next
   For Each sh In ActiveWorkbook.Worksheets
       t = t + sh.Hyperlinks.Count
       For Each link In sh.Hyperlinks
           x = x + 1
           link.Delete
       Next
   Next
   MsgBox "Foram eliminados " & x & " de " & t & " hyperlinks", _
           vbInformation, _
          "Eliminar Hyperlinks"
End Sub

 

Macro para utilizar no Microsoft Word

'--------------------------------------------------
' www.jjoao.com
'--------------------------------------------------
Sub EliminarHyperlinksWord()
    Dim link As Hyperlink
    Dim x As Integer, t As Integer
    Dim wDoc As Document
    Set wDoc = ActiveDocument
    t = wDoc.Hyperlinks.Count
    If t = 0 Then
       MsgBox "Não existem hyperlinks neste documento", _
               vbCritical, _
              "Eliminar Hyperlinks"
       GoTo fim
    End If
    Do While wDoc.Hyperlinks.Count > 0
      For Each link In wDoc.Hyperlinks
         x = x + 1
         link.Delete
      Next
    Loop
    MsgBox "Foram eliminados " & x & " de " & t & " hyperlinks", _
            vbInformation, _
           "Eliminar Hyperlinks"
fim:
    Set wDoc = Nothing
End Sub

Deixe um comentário