Macro per Collegamento ipertestuale

Hai un problema con Excel?

Nuova discussione

Macro per Collegamento ipertestuale
di Ralphy (utente non iscritto) data: 24/11/2016 09:14:27
Buongiorno,

Chiedo aiuto per questa macro che dovrebbe salvare una cartella excel e successivamente aggiungere un collegamento ipertestuale
al file appena salvato in una cella specifica di un altro figlio Excel ( cartella 2).
Purtroppo quando eseguo la macro appare :

Errore: 400 (se avvio da pulsante)
Errore: proprietà o metodo non supportati dll'oggetto ( se avvio da VBA)

Spero che qualcuno possa aiutarmi !!!
Grazie in anticipo

Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
    Case 0:    IsWorkBookOpen = False
    Case 70:   IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function

Sub salvaMUNTERS()
Dim C As String, directory As String
Dim X As String


C = Worksheets("Calc").Range("B5") & " " & Worksheets("Calc").Range("C3").Value
directory = Worksheets("Cartelle").Range("B3") & ""
ActiveWorkbook.SaveAs FileName:=directory & C & ".xlsm"

Worksheets("Ordine Pola").Range("V7") = "FATTO"
Worksheets("Pola Prof.Inv.").Range("V7") = "FATTO"

MsgBox ("Inciso nell'argilla!")


Dim r As Integer
Dim valore As String
Dim numero As String
Dim percorso As String
Dim anno As String
Dim nome As String


percorso = directory & C & ".xlsm"
Worksheets("Calc").Range("U33") = percorso
Worksheets("Calc").Range("U28").Select
anno = Selection
valore = Worksheets("Calc").Range("C65").Value

nome = Worksheets("Calc").Range("U29")

ret = IsWorkBookOpen(Worksheets("Calc").Range("U25").Value)  'cartella 2 
If ret = False Then
Workbooks.Open FileName:=Worksheets("Calc").Range("U25").Value

End If


For r = 2 To 200
numero = Workbooks(nome).Worksheets(anno).Cells(r, 2).Value

If valore = numero Then

With Workbooks(nome)

 .Hyperlinks.Add Anchor:=Worksheets(anno).Cells(r, 2), _
 Address:=percorso, _
 ScreenTip:="Vai a file ordine", _
 TextToDisplay:=valore
 
End With

Active.Workbook.Save

Exit Sub
End If
Next r



End Sub

di patel data: 24/11/2016 11:19:26
allega un file di esempio per testare la macro
di Ralphy (utente non iscritto) data: 24/11/2016 11:51:42
Ciao Patel,

grazie per aver risposto alla mia richiesta di aiuto :)
ti ho appena allegato sia il file che viene salvato che la Cartella 2 dove dovrebbe essere inserito il collegamento ip.

Spero che basti per cercare di risolvere :)
Grazie in anticipo
di patel data: 24/11/2016 12:56:23
sostituisci queste 2righe
Worksheets("Calc").Range("U28").Select
anno = Selection
con
anno = Worksheets("Calc").Range("U28")

non puoi usare select se il foglio non è stato già prima selezionato.
La prima regola per programmare in VBA è MAI usare select

di Ralphy (utente non iscritto) data: 24/11/2016 13:18:59
grazie per la tua pronta risposta !!
Ho fatto come mi hai suggerito.
Ho anche specificato workbooks e worksheets della cella (r,2) perchè prima andava a pescare nel foglio "Calc".

Rimane un problema.
Quando la macro arriva al codice hyperlink.add spunta

Errore di run time 424 : necessario oggetto

Dove sbaglio ???
Grazieee

percorso = directory & C & ".xlsm"
Worksheets("Calc").Range("U33") = percorso
anno = Worksheets("Calc").Range("U28")
valore = Worksheets("Calc").Range("C65").Value
seqM = Worksheets("Calc").Range("U29")

ret = IsWorkBookOpen(Worksheets("Calc").Range("U25").Value)
If ret = False Then
Workbooks.Open FileName:=Worksheets("Calc").Range("U25").Value

End If

For r = 2 To 200

numero = Workbooks(seqM).Worksheets(anno).Cells(r, 2).Value

If valore = numero Then


With Activeworksheets

 .Hyperlinks.Add Anchor:=.Cells(r, 2), _
 Address:=percorso, _
 ScreenTip:="Vai a file ordine", _
 TextToDisplay:=valore
 
End With

Active.Workbook.Save

Exit Sub
End If
Next r

End Sub

di patel data: 24/11/2016 15:32:36
cambia
With Activeworksheets
con
With Activesheet
di Ralphy (utente non iscritto) data: 24/11/2016 15:45:45
Purtroppo mi rimanda sempre lo stesso errore.
di patel data: 24/11/2016 16:14:47
il file allegato contiene una macro diversa da quella che hai incollato sopra

Vuoi Approfondire?