Création et suppression automatique de liens hypertextes pour nouvelles feuilles

caseras

XLDnaute Nouveau
Bonjour le forum,

Je cherche à obtenir une macro qui permettrait de lister sur ma feuille 1 (appelé Do, un document type) des liens hypertextes pour environ 100 feuilles.

J'ai une macro qui permet de créer des copies de feuille, j'ai une cellule qui reprend le nom de la feuille (en A1), j'ai une pseudo macro qui crée des liens hypertextes, malheureusement, cette macro présente trois problèmes :

1. Les liens hypertextes ne se créent pas automatiquement sur ma feuille 1 avec la création d'une nouvelle feuille , je suis obligé d’exécuter la macro, ce qui ne m'arrange pas des masses !

2. Lorsque j'efface mes feuilles (appelées archives dans mon document) les liens hypertextes sont conservés sur ma feuille de listing, ce qui ne me sert plus à rien.

3. Enfin, tous les liens se listent les uns en dessous des autres sous une seule colonne ==> alors que dans l'idéal il faudrait pour des raisons de visibilité pouvoir les lister sur deux colonnes A et G à partir de la ligne 40....

J'ai fait un bouton appelé "archiver" qui renvoie à la macro du même nom , je pense qu'il doit être possible de compléter cette macro pour qu'elle crée dans le même temps ces liens hypertextes ???

Idem pour la suppression des liens hypertextes je pense que ça doit être possible de les supprimer en regroupant la suppression des autres feuilles (bon j'ai essayé... le résultat est minablissime ça bug tout le temps, du coup j'ai supprimé et laissé ce qui fonctionnait ! :D )

Etant donné que cette macro n'est pas du tout, mais alors pas du tout à ma portée je me tourne vers vous !

Merci pour votre aide.

:)
 

Pièces jointes

  • do 2.xlsm
    64.9 KB · Affichages: 55
Dernière édition:

caseras

XLDnaute Nouveau
Re : Création et suppression automatique de liens hypertextes pour nouvelles feuilles

Re,

Etant donné que je vois que mon fichier a été affiché 8 fois, je le remonte, histoire de savoir si des gens s'intéressent à mon problème et puis s'il y a de nouveaux amateurs... sait-on jamais ! :)
 

job75

XLDnaute Barbatruc
Re : Création et suppression automatique de liens hypertextes pour nouvelles feuilles

Bonjour caseras,

Vous n'avez pas de réponse car votre fichier ne représente pas bien le problème.

Si j'ai bien compris, mettez dans le ThisWorkbook :

Code:
Private Sub Workbook_Open()
Workbook_SheetActivate ActiveSheet
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name <> "Do" Then Exit Sub
Dim ligdeb&, lig&, col As Byte, w As Worksheet, a$
ligdeb = 42 '1ère ligne de liens, à adapter
col = 1 'colonne A, à adapter
Application.ScreenUpdating = False
Sh.Unprotect "hello"
Sh.Rows(ligdeb & ":" & Sh.Rows.Count).Delete
lig = ligdeb
For Each w In Worksheets
  If w.Name <> Sh.Name Then
    a = "#'" & w.Name & "'!A1"
    Sh.Hyperlinks.Add Sh.Cells(lig, col), "", a, a, w.Name
    lig = lig + 1
    If lig = ligdeb + 50 Then lig = ligdeb: col = col + 6 'colonne G
  End If
Next
Sh.Rows(ligdeb & ":" & ligdeb + 50).Font.Size = 18
Sh.Rows(ligdeb & ":" & ligdeb + 50).AutoFit
Sh.Protect "hello"
Sh.EnableSelection = xlNoRestrictions
End Sub
Les liens hypertextes sont mis à jour chaque fois que la feuille "Do" est activée.

Nota : il vaut mieux le ThisWorkbook car ainsi on peut créer une liste dans les feuilles qu'on veut.

Fichier joint.

A+
 

Pièces jointes

  • Liens hypertextes(1).xlsm
    48.8 KB · Affichages: 50

job75

XLDnaute Barbatruc
Re : Création et suppression automatique de liens hypertextes pour nouvelles feuilles

Re,

Si l'on veut remplir les colonnes A et G un coup à gauche un coup à droite, remplacer :

Code:
lig = lig + 1
If lig = ligdeb + 50 Then lig = ligdeb: col = col + 6 'colonne G
par :

Code:
If col = 1 Then col = 7 Else lig = lig + 1: col = 1
Fichier (2).

Bonne nuit.
 

Pièces jointes

  • Liens hypertextes(2).xlsm
    52 KB · Affichages: 41

caseras

XLDnaute Nouveau
Re : Création et suppression automatique de liens hypertextes pour nouvelles feuilles

Eh ben... J'en ai pour un bon moment à comprendre ce que dit votre code.. mais ce qui est sur c'est que ça marche !

Merci c'est top ! ! ! :)

Bonne nuit à vous aussi !
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 910
Membres
101 837
dernier inscrit
Ugo