Grazie a tutti per aver risposto alo mio quesito, ma nella macro quale collegamento devo inserire?
devo mettere il collegamento alla cartella che contiene le varie cartelle contenti i pdf?
UTILIZZANDO LA MACRO CHE TROVO SOPRA, mi permette di selezionare la cartella contente i pdf, mi permette di andare a selezionare il file dove voglio copiare i pdf.
Nel mio caso vorrei sostituire nella posizione corretta i collegamenti già presenti nella colonna f del mio foglio Excel.
E' possibile modificare la macro in modo da riassocire questi collegamenti nella corretta psizione?
Eseguendo la macro legge dalla cartella i vari PDF e li incolla nel File nella posizione assegnata in un ordine casule, o seguendo una regola che non riesco a comprendere. Posso assegnare delle regole nella creazione dei collegamenti ipertestuali?
allego la macro che sto utilizzando
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
vi ringrazio
[Modificato da MAURIZIO1989 21/05/2018 10:28]