lien vers page suivante et précédente

maval · 15 Décembre 2018

Bonjour

J'ai un code pour me rendre en page d'accueil qui fonctionne très bien j'aimerai lui apporter une modification. Mon code:

Code:

Sub inser_liens_hypertext()
Dim sh As Worksheet
For Each sh In Worksheets
If sh.Name <> "Accueil" Then
    sh.Activate
    sh.Range("A1").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "Accueil!A1", TextToDisplay:="Retour page d'Accueil"
End If
Next sh
Sheets("Accueil").Activate
End Sub

J'aimerai ajouter à ce code la mention suivant précédent.

je vous remercie d'avance

Max

job75 · 15 Décembre 2018

Bonjour maval,

Avant de vous aider j'attendrai que vous donniez suite aux solutions proposées dans les autres fils :

https://www.excel-downloads.com/threads/changement-de-caracteres.20027436/

Et ce n'est pas la 1ère fois !

A+

job75 · 15 Décembre 2018

Re,

Voyez le fichier joint et cette macro dans ThisWorkbook :

Code:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If TypeName(Sh) <> "Worksheet" Then Exit Sub
Application.ScreenUpdating = False
Sh.[A1:A3].Clear 'RAZ (au cas où l'on modifie l'ordre des feuilles)
If Sh.Name <> "Accueil" Then Sh.Hyperlinks.Add Sh.[A1], "", "Accueil!A1", TextToDisplay:="Accueil"
If Sh.Index > 1 Then Sh.Hyperlinks.Add Sh.[A2], "", Sheets(Sh.Index - 1).Name & "!A1", TextToDisplay:="Précédent"
If Sh.Index < Sheets.Count Then Sh.Hyperlinks.Add Sh.[A3], "", Sheets(Sh.Index + 1).Name & "!A1", TextToDisplay:="Suivant"
Sh.[A1:A3].Sort Sh.[A1], Header:=xlNo 'tri pour supprimer les vides
End Sub

Elle se déclenche quand on active une feuille quelconque.

A+

maval · 15 Décembre 2018

Re,

Super juste une petite modif est-il possible d'avoir:

Accueil en "E1" Précédent "F1" et suivant en "G1"

Je vous remercie

maval · 15 Décembre 2018

Re,

C'est bon j'ai modifier,

Code:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If TypeName(Sh) <> "Worksheet" Then Exit Sub
Application.ScreenUpdating = False
Sh.[E1:G1].Hyperlinks.Delete 'RAZ (au cas où l'on modifie l'ordre des feuilles)
If Sh.Name <> "Accueil" Then Sh.Hyperlinks.Add Sh.[E1], "", "Accueil!E1", TextToDisplay:="Accueil"
If Sh.Index > 1 Then Sh.Hyperlinks.Add Sh.[F1], "", Sheets(Sh.Index - 1).Name & "!E1", TextToDisplay:="Précédent"
If Sh.Index < Sheets.Count Then Sh.Hyperlinks.Add Sh.[G1], "", Sheets(Sh.Index + 1).Name & "!E1", TextToDisplay:="Suivant"
Sh.[E1:G1].Sort Sh.[E1], Header:=xlNo 'tri pour supprimer les vides
End Sub

Je vous remercie Nickel

job75 · 15 Décembre 2018

Re,

Je me disais aussi...

Mais pour le tri à la fin il faut un tri horizontal :

Code:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If TypeName(Sh) <> "Worksheet" Then Exit Sub
Application.ScreenUpdating = False
Sh.[E1:G1].Clear 'RAZ (au cas où l'on modifie l'ordre des feuilles)
If Sh.Name <> "Accueil" Then Sh.Hyperlinks.Add Sh.[E1], "", "Accueil!E1", TextToDisplay:="Accueil"
If Sh.Index > 1 Then Sh.Hyperlinks.Add Sh.[F1], "", Sheets(Sh.Index - 1).Name & "!E1", TextToDisplay:="Précédent"
If Sh.Index < Sheets.Count Then Sh.Hyperlinks.Add Sh.[G1], "", Sheets(Sh.Index + 1).Name & "!E1", TextToDisplay:="Suivant"
Sh.[E1:G1].Sort Sh.[E1], Orientation:=xlByColumns 'facultatif, tri horizontal pour supprimer les vides
End Sub

A+

maval · 15 Décembre 2018

Re,

Il est possible de supprimer le soulignement des liens?
Merci pour tout

job75 · 15 Décembre 2018

maval à dit:
Il est possible de supprimer le soulignement des liens?

Oui en modifiant le format des cellules mais ce serait dommage...

Par ailleurs je vois au post #5 que vous avez utilisé :

Code:

Sh.[E1:G1].Hyperlinks.Delete 'RAZ (au cas où l'on modifie l'ordre des feuilles)

alors qu'il faut :

Code:

Sh.[E1:G1].Clear 'RAZ (au cas où l'on modifie l'ordre des feuilles)

maval · 16 Décembre 2018

Bonjour,

Je vous remercie et vous souhaite une bonne journée

Max

lien vers page suivante et précédente

maval

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

maval

XLDnaute Barbatruc

maval

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

maval

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

maval

XLDnaute Barbatruc

Discussions similaires