vba Excel inserisce Hyperlinks

‘

‘ vba  Excel inserisce Hyperlinks

‘

Sub InserisciLinkSupportif(colonnadocumento)

'

On Error Resume Next

'

Dim fs, archivio, percorso, h

Set fs = CreateObject("Scripting.FileSystemObject")

percorso = "\\Caem02\cosanostra\supporti\" ' cartella in cui sono presenti i files

'

Dim quanterighe, contarighe, foglio, contenuto

Set foglio = Sheets(ActiveSheet.Name)

' conteggio delle righe utilizzate

quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row

'

' cancella link presenti

Range("C2:C65536").Hyperlinks.Delete

'

contarighe = 2

While contarighe <= quanterighe

      contenuto = Trim(foglio.Cells(contarighe, colonnadocumento).Value)

      If Len(contenuto) > 0 Then

         archivio = percorso & contenuto & ".pdf"

         If fs.FileExists(archivio) = True Then

            foglio.Cells(contarighe, colonnadocumento).Select

            foglio.Hyperlinks.Add Anchor:=Selection, Address:=archivio

         End If

      End If

      contarighe = contarighe + 1

Wend

'

End Sub

'