feuille et hyperlinks

Salut
Cela peut-être utile

Sub CreationLiens()
Dim Feuille As Worksheets, n As Integer, L As Integer
Dim ExisteFeuille As Boolean, wCell As Range, Réponse As Long
On Error Resume Next
ExisteFeuille = Worksheets("Répertoire").Name
If Err.Number = 9 Then
Err.Clear
Réponse = _
MsgBox("Il faut une feuille nommée ""Répertoire"" !" & vbCrLf _
& "Voulez-vous la créer ?", vbYesNo, _
"Création des liens Hypertextes")
If Réponse = vbNo Then Exit Sub
ActiveWorkbook.Worksheets.Add before:=Sheets(1)
ActiveSheet.Name = "Répertoire"
End If
On Error GoTo 0
With Sheets("Répertoire")
L = 1
.Cells.Clear
For n = 1 To Worksheets.Count
If Worksheets(n).Name <> "Ré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épertoire").Name _
& "'!" & .Cells(L, 1).Address(0, 0)

wCell.Value = "Retour au Répertoire"
End If
L = L + 1
Set wCell = Nothing
End If
Next
End With
End Sub
'********* Fin du code ***********

Salut

Pascal


"Thierry" <tschweitzer@oxfam.org.uk> a écrit dans le message de news:
e8UzsOioDHA.2188@TK2MSFTNGP11.phx.gbl...

bjr

je voudrais pouvoir creer automatiquement dans une feuille excel la liste
de

tout les feuilles du fichier avec un lien hyper texte.
Comme cela je peux aller en un click a la feuille desirer, mon fichier
fais

plus de 100 feuilles ....

merci d'avance

j'ai rien trouver sous disciplus simplex !!

bonjour Thierry,
ce n'est pas automatique mais
Insertion
Lien hypertexte (ou Ctrl K)
et emplacement dans ce document
et tu choisis la feuille et la cellule où tu veux te rendre
et ainsi de suite pour les autres feuilles

Ou tu fais un 1er lien puis tu le recopies et il suffit ensuite de changer
le nom de feuille

Bon courage

Francis
"Thierry" <tschweitzer@oxfam.org.uk> a écrit dans le message news:
e8UzsOioDHA.2188@TK2MSFTNGP11.phx.gbl...

bjr

je voudrais pouvoir creer automatiquement dans une feuille excel la liste
de

tout les feuilles du fichier avec un lien hyper texte.
Comme cela je peux aller en un click a la feuille desirer, mon fichier
fais

plus de 100 feuilles ....

merci d'avance

j'ai rien trouver sous disciplus simplex !!

Bonjour
C'est normal que tu n'aies rien trouvé ... Disciplus a déménagé chez
excelabo :-)
Mais de toutes façons il n'y a aps en stock ce que tu cherches. Tu peux
cependant j'imagine le faire assez facilement à partir de ceci :
http://www.excelabo.net/xl/repertoires.php#listecommentée
(envoie ta solution quand tu l'auras ;-) !

Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta


le 03/11/2003 17:01:

bjr

je voudrais pouvoir creer automatiquement dans une feuille excel la liste de
tout les feuilles du fichier avec un lien hyper texte.
Comme cela je peux aller en un click a la feuille desirer, mon fichier fais
plus de 100 feuilles ....

merci d'avance

j'ai rien trouver sous disciplus simplex !!

Salut @ Tous, Thierry a écrit:

bjr

je voudrais pouvoir creer automatiquement dans une feuille excel la liste de
tout les feuilles du fichier avec un lien hyper texte.
Comme cela je peux aller en un click a la feuille desirer, mon fichier fais
plus de 100 feuilles ....

merci d'avance

j'ai rien trouver sous disciplus simplex !!

Un autre moyen en utilisant un UserForm, ce qui permettrais d'éviter de
revenir sur ta page de liens pour changer de feuilles; si tu navigues
beaucoups ;-)) ce qui peut être fastidieux avec une centaine de pages.

Créer un USF avec un ComboBox
Code de l'UserForm:
Private Sub ComboBox1_Click()
Sheets(ComboBox1.Value).Select
End Sub

Private Sub UserForm_Initialize()
Remplissage
End Sub


Dans un Module Standard:
Sub LanceUSF()
UserForm1.Show vbModeless
End Sub

Sub Remplissage()
Dim i As Integer
With UserForm1.ComboBox1
.Clear
.Value = ActiveSheet.Name
For i = 1 To Worksheets.Count
.AddItem Sheets(i).Name
Next i
End With
End Sub


Dans le Module ThisWorkbook
Private Sub Workbook_Activate()
LanceUSF
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Unload UserForm1
End Sub

Private Sub Workbook_Deactivate()
UserForm1.Hide
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Remplissage
End Sub

Private Sub Workbook_Open()
LanceUSF
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Remplissage
End Sub

Voili testé sous 2000 mais surement à adapter.
Un exemple dans ta BAL si elle est valide

--
@+
Thierry

Bonsoir,

Une solution de ChrisV d'octobre 2001 (et qui a échappé à l'attention de Misange
?? :) :

'==================== 'Créer une feuille "Sommaire" avec les noms des feuilles du classeur
'et un lien hypertexte vers chacune d'elles

Sub ListFeuil()
'ChrisV, mpfe
Application.ScreenUpdating = False
Set nSht = Sheets.Add(Before:=Sheets(1))
On Error GoTo GesErr
DebProc:
nSht.Name = "Sommaire"
[A1] = "Liste des onglets du classeur"
With Selection.Font
.Bold = True
.Size = 12
End With
For i = 2 To Sheets.Count
nSht.Cells(i, 1).Value = Sheets(i).Name
With Worksheets(nSht.Name)
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(i, 2), _
Address:="", SubAddress:=Sheets(i).Name & "!A1", _
TextToDisplay:="Lien vers " & Sheets(i).Name
End With
Next i
With Rows("1:1")
.RowHeight = 40
.VerticalAlignment = xlCenter
End With
[E2].Activate
ActiveWindow.DisplayGridlines = False
Exit Sub
GesErr:
Application.DisplayAlerts = False
Sheets("Sommaire").Delete
Application.DisplayAlerts = True
GoTo DebProc
End Sub
'====================
FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

bjr

je voudrais pouvoir creer automatiquement dans une feuille excel la liste de
tout les feuilles du fichier avec un lien hyper texte.
Comme cela je peux aller en un click a la feuille desirer, mon fichier fais
plus de 100 feuilles ....

merci d'avance

j'ai rien trouver sous disciplus simplex !!

Une solution de ChrisV d'octobre 2001 (et qui a échappé à l'attention
de Misange

?? :) :

Plus pour longtemps !

Le mieux c'est qu'elle doit être stockée quelque part en attente... J'ai
comme ça un dossier pas si mal classé avec peut être 500 astuces
surement géniales en attente ! Parfois j'ai juste un code et comme j'ai
oublié de garder le post qui posait la question, je ne vois plus trop ce
que ça faisait.
Je réarchive. Mais dans combien de temps se désarchivera-t-il ? That is
the question
Merci de l'avoir renvoyée Frédéric :-)

Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta

papyty tu mas donner la meilleur solution et franchement ca vaudrait le coup
de le rajouter chez disciplus simplex

un peut de code qui permet d'avoir un menu flottant deroulant avec la liste
de pages, il suffit de choisir la page pour y aller, simple et pratique

"Papyty" <papyty@yahoo.fr> wrote in message
news:1c1l08t9d5oy3$.1kjhwodtnar6u$.dlg@40tude.net...

Salut @ Tous, Thierry a écrit:

bjr

je voudrais pouvoir creer automatiquement dans une feuille excel la
liste de

tout les feuilles du fichier avec un lien hyper texte.
Comme cela je peux aller en un click a la feuille desirer, mon fichier
fais

plus de 100 feuilles ....

merci d'avance

j'ai rien trouver sous disciplus simplex !!

Un autre moyen en utilisant un UserForm, ce qui permettrais d'éviter de
revenir sur ta page de liens pour changer de feuilles; si tu navigues
beaucoups ;-)) ce qui peut être fastidieux avec une centaine de pages.

Créer un USF avec un ComboBox
Code de l'UserForm:
Private Sub ComboBox1_Click()
Sheets(ComboBox1.Value).Select
End Sub

Private Sub UserForm_Initialize()
Remplissage
End Sub


Dans un Module Standard:
Sub LanceUSF()
UserForm1.Show vbModeless
End Sub

Sub Remplissage()
Dim i As Integer
With UserForm1.ComboBox1
.Clear
.Value = ActiveSheet.Name
For i = 1 To Worksheets.Count
.AddItem Sheets(i).Name
Next i
End With
End Sub


Dans le Module ThisWorkbook
Private Sub Workbook_Activate()
LanceUSF
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Unload UserForm1
End Sub

Private Sub Workbook_Deactivate()
UserForm1.Hide
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Remplissage
End Sub

Private Sub Workbook_Open()
LanceUSF
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Remplissage
End Sub

Voili testé sous 2000 mais surement à adapter.
Un exemple dans ta BAL si elle est valide

--
@+
Thierry

Salut @ Tous, Thierry a écrit:

papyty tu mas donner la meilleur solution et franchement ca vaudrait le coup
de le rajouter chez disciplus simplex

un peut de code qui permet d'avoir un menu flottant deroulant avec la liste
de pages, il suffit de choisir la page pour y aller, simple et pratique

Merci c'est avec plaisir


--
@+
Thierry

Salut @ Tous, Thierry a écrit:

papyty tu mas donner la meilleur solution et franchement ca vaudrait le coup
de le rajouter chez disciplus simplex

un peut de code qui permet d'avoir un menu flottant deroulant avec la liste
de pages, il suffit de choisir la page pour y aller, simple et pratique

Voici une autre approche qui peut etre utile
Création d'un menu contextuel avec click droit sur les cellules

Dans un module Standard:
______________________________________________________
Sub IniMenu()

On Error Resume Next
Application.CommandBars("Cell"). _
Controls("Onglets").Visible = True
If Err = 0 Then Exit Sub

Set MyBar = Application.CommandBars("Cell"). _
Controls.Add(msoControlPopup)
MyBar.Caption = "Onglets"
MyBar.OnAction = "AjoutFeuilles"

End Sub

Private Sub AjoutFeuilles()
On Error Resume Next
Set MyBar = Application.CommandBars("Cell"). _
Controls("Onglets")

For Nb = MyBar.Controls.Count To 1 Step -1
MyBar.Controls(Nb).Delete
Next
Nb = Application.Sheets.Count
men = Int(Nb / 30) + 1
Reste = Nb Mod 30
Fi = 30
Ii = 1
For i = 1 To men
If i = men Then Fi = (men - 1) * 30 + Reste
Nom = "menu" & i
Set Nom = MyBar.CommandBar.Controls _
.Add(Type:=msoControlPopup, ID:=1)
Nom.Caption = "De " & Ii & " à " & Fi
Comp = i
If i = men Then
Fin = (Comp - 1) * 30 + Reste
Else
Fin = Comp * 30
End If
For J = (Comp - 1) * 30 + 1 To Fin
Nom2 = "menus" & J
Set Nom2 = Nom.CommandBar.Controls _
.Add(Type:=msoControlButton, ID:=1)
Nom2.Caption = ActiveWorkbook.Sheets(J).Name
Nom2.OnAction = "'Allez(" & J & ")'"
Comp = Comp + 1
Next J
Fi = Fi + 30
Ii = Ii + 30
Next i
End Sub

Sub SupMenu()
On Error Resume Next
Application.CommandBars("Cell"). _
Controls("Onglets").Delete
End Sub

Function Allez(N As Integer)
ActiveWorkbook.Sheets(N).Select
End Function
_______________________________________________

Dans ThisWorkbook:

Private Sub Workbook_Activate()
IniMenu
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
SupMenu
End Sub

Private Sub Workbook_Deactivate()
SupMenu
End Sub

Private Sub Workbook_Open()
IniMenu
End Sub
_______________________________________________

Si ça te convient
--
@+
Thierry

C'est pas mal aussi, je crois que je prefere la premiere solution avec le
menu deroulant, j'ai augmenter le nimber de ligne visible. Par contre je
n'arrive pas a faire rester le menu en haut a droit de la page ?? une idee
pour remedier a ce petit problem ??
"Papyty" <papyty@yahoo.fr> wrote in message
news:pklrtdj6yiy4$.1d6uvpkeak3cg.dlg@40tude.net...

Salut @ Tous, Thierry a écrit:

papyty tu mas donner la meilleur solution et franchement ca vaudrait le
coup

de le rajouter chez disciplus simplex

un peut de code qui permet d'avoir un menu flottant deroulant avec la
liste

de pages, il suffit de choisir la page pour y aller, simple et pratique

Voici une autre approche qui peut etre utile
Création d'un menu contextuel avec click droit sur les cellules

Dans un module Standard:
______________________________________________________
Sub IniMenu()

On Error Resume Next
Application.CommandBars("Cell"). _
Controls("Onglets").Visible = True
If Err = 0 Then Exit Sub

Set MyBar = Application.CommandBars("Cell"). _
Controls.Add(msoControlPopup)
MyBar.Caption = "Onglets"
MyBar.OnAction = "AjoutFeuilles"

End Sub

Private Sub AjoutFeuilles()
On Error Resume Next
Set MyBar = Application.CommandBars("Cell"). _
Controls("Onglets")

For Nb = MyBar.Controls.Count To 1 Step -1
MyBar.Controls(Nb).Delete
Next
Nb = Application.Sheets.Count
men = Int(Nb / 30) + 1
Reste = Nb Mod 30
Fi = 30
Ii = 1
For i = 1 To men
If i = men Then Fi = (men - 1) * 30 + Reste
Nom = "menu" & i
Set Nom = MyBar.CommandBar.Controls _
.Add(Type:=msoControlPopup, ID:=1)
Nom.Caption = "De " & Ii & " à " & Fi
Comp = i
If i = men Then
Fin = (Comp - 1) * 30 + Reste
Else
Fin = Comp * 30
End If
For J = (Comp - 1) * 30 + 1 To Fin
Nom2 = "menus" & J
Set Nom2 = Nom.CommandBar.Controls _
.Add(Type:=msoControlButton, ID:=1)
Nom2.Caption = ActiveWorkbook.Sheets(J).Name
Nom2.OnAction = "'Allez(" & J & ")'"
Comp = Comp + 1
Next J
Fi = Fi + 30
Ii = Ii + 30
Next i
End Sub

Sub SupMenu()
On Error Resume Next
Application.CommandBars("Cell"). _
Controls("Onglets").Delete
End Sub

Function Allez(N As Integer)
ActiveWorkbook.Sheets(N).Select
End Function
_______________________________________________

Dans ThisWorkbook:

Private Sub Workbook_Activate()
IniMenu
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
SupMenu
End Sub

Private Sub Workbook_Deactivate()
SupMenu
End Sub

Private Sub Workbook_Open()
IniMenu
End Sub
_______________________________________________

Si ça te convient
--
@+
Thierry