macro, creare un collegamento ipertestuale

Question

salve, vi spiego il mio problema.

Ho creato con il vostro aiuto un file excel contente dei collegamenti ipertestuali a dei pdf contenuti in delle cartelle.

Ho trovato una macro che mi permette di andare a selezionare la cartella contenente i vari pdf, una volta selezionata la cartella mi permette di selezionare il file su cui andrò ad incollare i vari collegamenti ipertestuali.

Come posso andare a modificare la macro in modo da poter riassociare nella corretta posizione i nel mio file i diversi collegamenti ipertestuali.

Allego la macro,

Option Explicit
Sub Inserisci_NomeFiles_Iperlink()
    Application.ScreenUpdating = False
    Dim fd As FileDialog
    Dim i As Integer
    Dim miaCartella
    Dim domanda As String
    Dim lunghezza As Integer
    Dim uR As Long
    Dim FileAltro As Variant
    Dim WK As Workbook
    Dim sh As Worksheet
    Dim fs As Object
    Dim Fold As Object
    Dim Nomefile As Object
    Dim Cartella As Object
    Dim colonna As String
    Dim riga As Integer
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    Dim CartellaSelezionata As Variant
    MsgBox "Scegli la cartella con i files ai quali attivare i collegamenti", vbInformation, "AVVISO"
    With fd
        If .Show = -1 Then
            i = 1
            For Each CartellaSelezionata In .SelectedItems
                miaCartella = CartellaSelezionata
            Next
        Else
            Exit Sub
        End If
    End With
    MsgBox "Scegli il file excel su cui copiare i collegamenti", vbInformation, "AVVISO"
    FileAltro = Application.GetOpenFilename
    If FileAltro = "Falso" Then
        MsgBox "Operazione annullata!", vbOKOnly + vbInformation
        Exit Sub
    End If
    Set WK = Workbooks.Open(FileAltro)
    Set sh = WK.Worksheets(1)
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set Fold = fs.getfolder(miaCartella)
    Set Cartella = Fold.Files
    domanda = InputBox("Scegli la cella iniziale per scrivere i collegamenti. (Esempio B2)")
    lunghezza = Len(domanda)
    For i = 1 To lunghezza
        If IsNumeric(Mid(domanda, i, 1)) = True Then
            Exit For
        End If
    Next i
    colonna = Left(domanda, i - 1)
    riga = Val(Replace(domanda, colonna, ""))
    On Error GoTo esci
    For Each Nomefile In Cartella
        While sh.Cells(riga, colonna).Value <> ""
            riga = riga + 1
        Wend
        DoEvents
        sh.Cells(riga, colonna) = Left(Nomefile.Name, InStr(Nomefile.Name, ".") - 1)
        ActiveSheet.Hyperlinks.Add Anchor:=sh.Cells(riga, colonna), Address:=Nomefile
    Next
    uR = sh.Cells(Rows.Count, colonna).End(xlUp).Row
    sh.Sort.SortFields.Clear
    sh.Sort.SortFields.Add Key:=Range(domanda & ":" & colonna & uR), Order:=xlAscending
    With sh.Sort
        .SetRange Range(domanda & ":" & colonna & uR)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    WK.Save
    WK.Close
    MsgBox "Fatto!", vbInformation, "NOTIFICA"
    Set fs = Nothing
    Set Cartella = Nothing
    Set Fold = Nothing
    Set fd = Nothing
    Application.ScreenUpdating = True
    Exit Sub
esci:
    MsgBox "Si è verificato un errore, forse non hai digitato correttamente la cella scelta." & vbCrLf & "Ripeti l'operazione!", vbExclamation, "ATTENZIONE"
    WK.Save
    WK.Close
End Sub

Answer 1

Ciao Maurizio,

rimane il problema della copia dei pdf. Se nella cartella i pdf sono contenuti in sottocartelle non viene copiato nulla.

Si può risolvere questo problema?

Non credo che tu abbia sollevato questa domanda - almeno non in questo thread.

Comunque, questo è un problema completamente diverso da quello che hai posto in questo thread, vale a dire:

Ho creato con il vostro aiuto un file excel contente dei collegamenti ipertestuali a dei pdf contenuti in delle cartelle.

Ho trovato una macro che mi permette di andare a selezionare la cartella contenente i vari pdf, una volta selezionata la cartella mi permette di selezionare il file su cui andrò ad incollare i vari collegamenti ipertestuali.

Come posso andare a modificare la macro in modo da poter riassociare nella corretta posizione i nel mio file i diversi collegamenti ipertestuali.

Mi pare che la macro che hai trovato non funzioni nel modo che vuoi. Comunque, per ottenere assistenza in questo forum, penso che sia necessario aprire un nuovo thread per questa diversa domanda.

===

Regards,

Norman

Answer 2

Ciao Maurizio,

dove devo andare ad inserire il comando?

Dove indicato in grassetto:   

Option Explicit

Sub Inserisci_NomeFiles_Iperlink()

    Application.ScreenUpdating = False

    Dim fd As FileDialog

    Dim i As Integer

    Dim miaCartella

    Dim domanda As String

    Dim lunghezza As Integer

    Dim uR As Long

    Dim FileAltro As Variant

    Dim WK As Workbook

    Dim sh As Worksheet

    Dim fs As Object

    Dim Fold As Object

    Dim Nomefile As Object

    Dim Cartella As Object

    Dim colonna As String

    Dim riga As Integer

    Set fd = Application.FileDialog(msoFileDialogFolderPicker)

    Dim CartellaSelezionata As Variant

    MsgBox "Scegli la cartella con i files ai quali attivare i collegamenti", vbInformation, "AVVISO"

    With fd

        If .Show = -1 Then

            i = 1

            For Each CartellaSelezionata In .SelectedItems

                miaCartella = CartellaSelezionata

            Next

        Else

            Exit Sub

        End If

    End With

    MsgBox "Scegli il file excel su cui copiare i collegamenti", vbInformation, "AVVISO"

    FileAltro = Application.GetOpenFilename

    If FileAltro = "Falso" Then

        MsgBox "Operazione annullata!", vbOKOnly + vbInformation

        Exit Sub

    End If

    Set WK = Workbooks.Open(FileAltro)

WK.BuiltinDocumentProperties("Hyperlink base") = _

"\NoServer\NoFolder"

    Set sh = WK.Worksheets(1)

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set Fold = fs.getfolder(miaCartella)

    Set Cartella = Fold.Files

    domanda = InputBox("Scegli la cella iniziale per scrivere i collegamenti. (Esempio B2)")

    lunghezza = Len(domanda)

    For i = 1 To lunghezza

        If IsNumeric(Mid(domanda, i, 1)) = True Then

            Exit For

        End If

    Next i

    colonna = Left(domanda, i - 1)

    riga = Val(Replace(domanda, colonna, ""))

    On Error GoTo esci

    For Each Nomefile In Cartella

        While sh.Cells(riga, colonna).Value <> ""

            riga = riga + 1

        Wend

        DoEvents

        sh.Cells(riga, colonna) = Left(Nomefile.Name, InStr(Nomefile.Name, ".") - 1)

        ActiveSheet.Hyperlinks.Add Anchor:=sh.Cells(riga, colonna), Address:=Nomefile

    Next

    uR = sh.Cells(Rows.Count, colonna).End(xlUp).Row

    sh.Sort.SortFields.Clear

    sh.Sort.SortFields.Add Key:=Range(domanda & ":" & colonna & uR), Order:=xlAscending

    With sh.Sort

        .SetRange Range(domanda & ":" & colonna & uR)

        .Header = xlGuess

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

    WK.Save

    WK.Close

    MsgBox "Fatto!", vbInformation, "NOTIFICA"

    Set fs = Nothing

    Set Cartella = Nothing

    Set Fold = Nothing

    Set fd = Nothing

    Application.ScreenUpdating = True

    Exit Sub

esci:

    MsgBox "Si è verificato un errore, forse non hai digitato correttamente la cella scelta." & vbCrLf & "Ripeti l'operazione!", vbExclamation, "ATTENZIONE"

    WK.Save

    WK.Close

End Sub

===

Regards,

Norman

Answer 3

Ciao Maurizio,

perchè  spostando o modificando i il file perdo alcuni collegamenti ipertestuali che ogni volta devo andare ad aggiornare in automatico.

se sposto il file da una cartella ad un'altra non posso far riaggiornare in automatico i collegamenti?

Prova a sostituire l'istruzione:

Set WK = Workbooks.Open(FileAltro)

con:    

    Set WK = Workbooks.Open(FileAltro)

    WK.BuiltinDocumentProperties("Hyperlink base") = "\NoServer\NoFolder"

===

Regards,

Norman

Answer 4

Ciao Maurizio, ,

salve, vi spiego il mio problema.

Ho creato con il vostro aiuto un file excel contente dei collegamenti ipertestuali a dei pdf contenuti in delle cartelle.

Ho trovato una macro che mi permette di andare a selezionare la cartella contenente i vari pdf, una volta selezionata la cartella mi permette di selezionare il file su cui andrò ad incollare i vari collegamenti ipertestuali.

OK.

Come posso andare a modificare la macro in modo da poter riassociare nella corretta posizione i nel mio file i diversi collegamenti ipertestuali.

Purtroppo, non capisco né l'esigenza né il suo motivo.

===

Regards,

Norman

Answer 5

perchè  spostando o modificando i il file perdo alcuni collegamenti ipertestuali che ogni volta devo andare ad aggiornare in automatico.

se sposto il file da una cartella ad un'altra non posso far riaggiornare in automatico i collegamenti?