De: "Benoît MARCHAND" <benmarch@club-internet.fr>
Objet: Re: Calendrier
Date : vendredi 16 f&eacute;vrier 2001 01:26

Salut multimedia13,


Voici un code qui te cr&eacute;ra une feuille appel&eacute; "R&eacute;pertoire" sur laquelle tu auras un
lien vers
toutes les feuilles de ton classeur ; sur chaque classeur, si l'une des cellules A1,
B1 ou C1
est vide, tu auras le lien de retour vers la feuille r&eacute;pertoire. Si les 3 cellules
(A1, B1 et
C1) sont remplies, tu n'auras pas de lien de retour. On peut modifier la cellule
recevant le
lien de retour en fonction de tes besoins.

'********* D&eacute;but du code ***********
Sub CreationLiens()
  Dim Feuille As Worksheets, n As Integer, L As Integer
  Dim ExisteFeuille As Boolean, wCell As Range, R&eacute;ponse As Long
    On Error Resume Next
     ExisteFeuille = Worksheets("R&eacute;pertoire").Name
     If Err.Number = 9 Then
        Err.Clear
        R&eacute;ponse = MsgBox("Il faut une feuille nomm&eacute; ""R&eacute;pertoire"" !" & vbCrLf _
            & "Voulez-vous la cr&eacute;r ?", vbYesNo, "Cr&eacute;ation des liens Hypertextes")
        If R&eacute;ponse = vbNo Then Exit Sub
        ActiveWorkbook.Worksheets.Add before:=Sheets(1)
        ActiveSheet.Name = "R&eacute;pertoire"
      End If
      On Error GoTo 0
  With Sheets("R&eacute;pertoire")
    L = 1
    .Cells.Clear
    For n = 1 To Worksheets.Count
      If Worksheets(n).Name <> "R&eacute;pertoire" Then
        .Activate
        .Hyperlinks.Add Anchor:=.Cells(L, 1), Address:="", SubAddress:="'" &
Worksheets(n).Name & "'!A1"
        .Cells(L, 1).Value = Worksheets(n).Name
        .Cells(L, 1).Select
        If Worksheets(n).[A1].Hyperlinks.Count = 1 Or IsEmpty(Worksheets(n).[A1])
Then
          set wCell = Worksheets(n).[A1]
        ElseIf Worksheets(n).[B1].Hyperlinks.Count = 1 Or IsEmpty(Worksheets(n).[B1])
Then
          set wCell = Worksheets(n).[B1]
        ElseIf Worksheets(n).[C1].Hyperlinks.Count = 1 Or IsEmpty(Worksheets(n).[C1])
Then
           set wCell = Worksheets(n).[C1]
        End If
        If Not wCell Is Nothing Then
          Worksheets(n).Hyperlinks.Add Anchor:=wCell, Address:="",  _
            SubAddress:="'" & Worksheets("R&eacute;pertoire").Name & "'!" & .Cells(L,
1).Address(0, 0)

          wCell.Value = "Retour au R&eacute;pertoire"
        End If
        L = L + 1
         set wCell = Nothing
      End If
    Next
  End With
End Sub
'********* Fin du code ***********

Un collègue de travail l'utilise sur un classeur de 150 onglets, il en est satisfait.

A+
Benead

multimedia13 a &eacute;crit :

> Bonjour à tous,
>
> J'ai cr&eacute;&eacute; 1 classeur dans lequel je vais mettre mon planning hebdomadaire.
> Ma feuille de planning est la même partout.
> Pour l'instant, ça va , nous sommes au d&eacute;but de l'ann&eacute;e . J'aimerais cr&eacute;r 1
> première feuille sur laquelle j'ins&eacute;rerais des boutons qui renvoient
> directement à la semaine demand&eacute;.
> Comment dois-je proc&eacute;der ?
>
> Ex : bouton "Semaine 32" renvoie directement à la feuille qui contient le
> planning de la semaine 32.
>
> Merci
>
> Anthony.


 