[VBA] Lien hypertexte entre feuille

[J0K0]

Bonsoir à toutes et tous,
J'explique mon cas : j'ai créer un classeur dont le but est de créer une feuille (lors d'un incident) où la feuille se renomme automatique en 1,2,3,.... Et l'intitulé de ce dernier se rajoute dans un tableau récapitulatif. A l'issu, j'aurais aimé faire automatiquement un lien hypertexte de cette cellule vers l'incident ou la feuille correspondante.
J'arrive presque à tout faire, sauf ce lien. Je bloque sur l'automatisation du nom de la feuille ...
Voici le code :
Sub Macro7()
ActiveSheet.Select
Range("A6:AL6").Copy
Page = ActiveSheet.Name
Sheets("recapitulatif").Select
Rows("5:5").Select
Selection.Insert Shift:=xlDown
Range("A5:AL5").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A5:AL5").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Workbook & Page
End Sub

D'avance, merci !

 

[Kobaya]

Re : [VBA] Lien hypertexte entre feuille

Bonsoir JOKO,

L'enregistreur de macro fait des merveilles :

Sub Macro7()
    Dim rngSource   As Range
    
    ActiveSheet.Select
    Range("A6:AL6").Copy
    Set rngSource = Selection
    
    Sheets("recapitulatif").Select
    Rows("5:5").Select
    Selection.Insert Shift:=xlDown
    Range("A5:AL5").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A5:AL5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Interior.ColorIndex = xlNone
    
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=rngSource.Worksheet.Name & "!" & rngSource.Address, TextToDisplay:=rngSource.Worksheet.Name
    
    Set rngSource = Nothing
End Sub

Est-ce que ça correspond à ce que tu attends ?

 

[J0K0]

[Résolu] [VBA] Lien hypertexte entre feuille

Hello !

Merci de cette réponse, vraiment !! En fait, ça marche !
J'essaie depuis quelques semaines sans résultats, je suis passé par l'enregistreur ce qui m'a permis d'avancer sur ça et d'autres choses, mais la finalité bloquait !

Encore une fois, MERCI !

 

[Kobaya]

Re : [Résolu] [VBA] Lien hypertexte entre feuille

Pas de quoi