HELP COLLEGAMENTI IPERTESTUALI IN EXCEL

Question

Salve a tutti! Avrei bisogno di un vostro aiuto, ho la necessità di far creare, in automatico, dei collegamenti ipertestuali in una colonna di excel, tutti diversi. E' possibile farlo?Mi spiego meglio:ho una cartella sul pc che contiene 100 foto e sono tutte rinominate in senso progressivo, 001.jpg - 002.jpg - 003.jpg....etc. fino a 100.jpg; ogni foto debbo collegarla (con un collegamento ipertestuale o semplicemente con inserisci commento) in una cella della stessa colonna su excel.....esiste un modo per fare questa operazione in automatico senza la necessità di farlo cento volte per ogni cella?Spero tanto che possiate aiutarmi.Grazie infinite per il vostro aiuto.Andrea Angelillis.

Answer 1

Ciao Andrea,

Avrei bisogno di un vostro aiuto, ho la necessità di far creare, in automatico, dei collegamenti ipertestuali in una colonna di excel, tutti diversi. E' possibile farlo? Mi spiego meglio:ho una cartella sul pc che contiene 100 foto e sono tutte rinominate in senso progressivo, 001.jpg - 002.jpg - 003.jpg....etc. fino a 100.jpg; ogni foto debbo collegarla (con un collegamento ipertestuale o semplicemente con inserisci commento) in una cella della stessa colonna su excel.....esiste un modo per fare questa operazione in automatico senza la necessità di farlo cento volte per ogni cella?

Prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

 '========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim WB As Workbook 

Dim SH\_Foto As Worksheet, SH\_Destinazione As Worksheet 

Dim Rng As Range 

Dim oPic As Picture 

Dim sNome As String 

Dim i As Long 

Const sFoglio\_Foto As String = **"Foglio1"                 '<<=== Modifica** 

Const sFoglio\_Destinazione As String = **"Foglio2"         '<<=== Modifica** 

Const sIntervallo\_Destinazione  As String = **"A1:A100"    '<<=== Modifica"** 

Set WB = ThisWorkbook 

With WB 

    Set SH\_Foto = .Sheets(sFoglio\_Foto) 

    Set SH\_Destinazione = .Sheets(sFoglio\_Destinazione) 

End With 

Set Rng = SH\_Destinazione.Range(sIntervallo\_Destinazione) 

For i = 1 To 100 

    sNome = Format(i, "000") & ".jpg" 

    On Error Resume Next 

    Set oPic = SH\_Foto.Pictures(sNome) 

    On Error GoTo 0 

    If Not oPic Is Nothing Then 

    SH\_Foto.Hyperlinks.Add \_ 

        Anchor:=SH\_Foto.Shapes(sNome), \_ 

        Address:="", SubAddress:="'" & sFoglio\_Destinazione \_ 

        & "'" & "!" & Rng.Cells(i).Address(0, 0) 

    End If 

    Set oPic = Nothing 

Next i 

End Sub

'<<========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm
• Alt+F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester
• Esegui

===

Regards,

Norman

![](https://learn-attachment.microsoft.com/api/attachments/f8bd5a94-15ce-4f83-a806-0d4ffe67096d?platform=QnA