Copia/incolla collegamento

Question

Ho una serie di oggetti su excel che hanno un collegamento ipertestuale.

Vorrei sapere se è possibile copiare il collegamento e incollarlo in una cella senza dover ogni volta fare tasto destro/modifica collegamento ipertestuale.

In alternativa potrei collegare questi oggetti direttamente alla cella che mi interessa, come posso farlo?

Answer 1

Ciao Filippo,

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:

 '------------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim destRng As Range

    Dim myShape As Shape

    Dim HL As Hyperlink

    Const sDestinazione = "D1"                       '<<===== Modifica

    Set WB = ActiveWorkbook

    Set SH = WB.Sheets("Foglio1")                   '<<===== Modifica

    Set destRng = SH.Range(sDestinazione)

    For Each myShape In SH.Shapes

    Set HL = Nothing

        On Error Resume Next

        Set HL = myShape.Hyperlink

        On Error GoTo 0

        If Not HL Is Nothing Then

            destRng.Value = HL.Address

            Set destRng = destRng.Offset(1)

        End If

    Next myShape

End Sub

'<<=============

Alt-Q per chiudere l'editor di VBA e tornare a Excel.

Alt-F8 per aprire la finestrina macro

Seleziona Tester | Esegui

===

Regards,

Norman

Answer 2

Ciao Filippo,

L'unica cosa è che non salta le righe vuote (ma ci inserisce il collegamento successivo).

Prova a sostituire il codice con la seguente versione:

'=============>>

Option Explicit

'------------->>

Public Sub Tester2()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim destRng As Range

    Dim myShape As Shape

    Dim HL As Hyperlink

    Dim rCell As Range

    Const sDestinazione = "D1"                               '<<===== Modifica

    Set WB = ActiveWorkbook

    Set SH = WB.Sheets("Foglio1")                            '<<===== Modifica

    Set destRng = SH.Range(sDestinazione)

    For Each myShape In SH.Shapes

    Set HL = Nothing

        On Error Resume Next

        Set HL = myShape.Hyperlink

        On Error GoTo 0

        If Not HL Is Nothing Then

            destRng.Value = HL.Address

        End If

        Set destRng = destRng.Offset(1)

    Next myShape

End Sub

'<<=============

Comunque, se tu  volessi copiare il collegamento ipertestuale piuttosto che il suo indirizzo, sostituisci il codice precedente con la seguente versione:

'=============>>

Option Explicit

'------------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim destRng As Range

    Dim myShape As Shape

    Dim HL As Hyperlink

    Dim rCell As Range

    Const sDestinazione = "D1"                               '<<===== Modifica

    Set WB = ActiveWorkbook

    Set SH = WB.Sheets("Foglio1")                            '<<===== Modifica

    Set destRng = SH.Range(sDestinazione)

    For Each myShape In SH.Shapes

    Set HL = Nothing

        On Error Resume Next

        Set HL = myShape.Hyperlink

        On Error GoTo 0

        If Not HL Is Nothing Then

            destRng.Value = HL.Address

            SH.Hyperlinks.Add Anchor:=destRng, _

        Address:=HL.Address, _

        TextToDisplay:=HL.Address

        End If

        Set destRng = destRng.Offset(1)

    Next myShape

End Sub

'<<=============

===

Regards,

Norman

Answer 3

Perfetto, ho sostituito quello in grassetto con i miei riferimenti e funziona!

L'unica cosa è che non salta le righe vuote (ma ci inserisce il collegamento successivo).

Comunque è un problema che ho risolto facilmente (in questo caso)