Lien relatif

kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010 - 22 avril 2010 à 14:50
kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010 - 23 avril 2010 à 08:16
bonjour voila ce code a part le lien principal genere des liens absolues et je veux qu il genere des relatifs ; je ne comprends pas pourquoi il ne marche pas

Sub Creation_Hypertexte()
Macro1
Range("A10").Select
MyPath = ActiveWorkbook.Path & ""
MyName = Dir(MyPath, vbDirectory)
i = 0
Do While MyName <> ""
    i = i + 1
    If MyName <> "." And MyName <> ".." And MyName <> ActiveWorkbook.Name Then
        If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
                ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="." & MyName, TextToDisplay:="|=>" & MyName
                ActiveCell.Font.Underline = False
                ActiveCell.Offset(1, 0).Select
                
                MyName2 = Dir("." & "" & MyName & "", vbDirectory)
                 Do While MyName2 <> ""
                    If MyName2 <> "." And MyName2 <> ".." Then
                        If (GetAttr("." & MyName & "" & MyName2) And vbDirectory) = vbDirectory Then
                        ActiveCell.Offset(0, 1).Select
                        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="." & MyName & "" & MyName2, TextToDisplay:="|=>" & MyName2
                        ActiveCell.Font.Underline = False
                        ActiveCell.Offset(1, -1).Select
                        End If
               
                    End If
                MyName2 = Dir
                Loop
                Do While MyName2 <> ""
                    If MyName2 <> "." And MyName2 <> ".." Then
                        If (GetAttr("." & MyName & "" & MyName2) And vbDirectory) <> vbDirectory Then
                        ActiveCell.Offset(0, 1).Select
                        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="." & MyName & "" & MyName2, TextToDisplay:=MyName2
                        ActiveCell.Font.Italic = True
                        ActiveCell.Font.Underline = False
                        ActiveCell.Offset(1, -1).Select
                        End If
                    End If
                MyName2 = Dir
                Loop
               
                
                
        End If
    End If
    
    MyName = Dir(MyPath, vbDirectory)
    For j = 0 To i
        MyName = Dir
    Next
    ActiveCell.Offset(2, 0).Select
Loop


    With ActiveWorkbook.PublishObjects("Sommaire Auto_21817")
        .HtmlType = xlHtmlStatic
        .Filename = _
        MyPath & "\Sommaire automatique.htm"
        .Publish (False)
    End With
    ChDir MyPath

End Sub


1 réponse

kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010
23 avril 2010 à 08:16
bon pas de reponse j'ai un peu avancé en remplacant MyPath par .\ mais je ne comprend pas pourquoi il se place sur mes documents à l enregistrement dans ce cas et non dans mon repertoire courant
0
Rejoignez-nous