Création d'un répertoire + lien hypertexte VBA

Bonjour à tous,

Amis(es) professionnels(les) je reviens vers vous concernant un sujet de "création de répertoire + lien"

Il se trouve que j'ai un tableau Excel avec des 1.Chapitres en Col A2, des 1.1.Sous chapitres en Col B2, des 1.1.1.Sous sous chapitres en Col C2, et des 1.1.1.1.Sous sous sous chapitres en Col D2,

J'aimerai pouvoir sortir seulement ces valeurs afin de créer un répertoire avec des liens direct sur la case,

Je vous joint un exemple ci dessus:

Merci de votre aide!!

Bonjour Willkaa,

Pour être sur de ta demande, tu veux une Macro qui te permet de faire une Mise en Forme d'un répertoire ?

Un truc que je ne comprends pas avec ton histoire de lien. Pourquoi tu as besoin de ca puisque tu as un tableau "Listing matériel" avec tout ?

En soit tu veux juste une page de présentation ?

Bien cordialement,

Bonjour à toi MPETIT,

Non pas simplement une mise en forme, sur une nouvelle feuille (via un bouton par exemple) je voudrais sortir les valeurs des chapitres et sous chapitres qu'il y a dans les colonnes A, B,C,D et créer des liens direct qui m'emmene dans le listing matériel.

Le but est de naviguer plus facilement sur une nouvelle feuille "sommaire"(répertoire) contrairement au listing, ou j'ai plus de 5000 articles, tu comprends?

@+

Will

Oui j'ai mieux compris, mais cela me parait vachement compliqué de faire de cette façon.

Mieux vaut utiliser un tableau et trier les données directement en utilisant des filtres.

Après ce n'est qu'une proposition.

Bien cordialement,

Bonjour à tous,

Voici un essai avec 2 façons de faire, une avec tableau et une en restant sur la présentation en arborescence de la feuille listing.

Il faut bien faire attention aux caractères des noms de dossier car certains sont interdits " < > ? / : \ * ? (et j'en oublie peut-être d'autres) et les noms ne peuvent en principe pas terminer par un espace ou un point. J'ai pensé à une fonction permettant de valider les noms mais je ne l'ai pas mise pour l'instant, j'ai préféré faire les modifs à la main...

Il faudra aussi modifier thisworkbook.path par le chemin désiré.

N'hésite pas si tu as des questions

Bonjour 3GB,

Je te présente mes meilleurs vœux les plus sincères pour cette nouvelle année 2021! Paix, santé et prospérité!En espérant que les fêtes ce soient passées pour le mieux!

C'est super ce que tu me présentes!! Mais ce n'est pas aussi subtile que cela ce que je recherche

Donc le répertoire, la façon tableau me plait bien, seulement le lien va trop loin, je souhaite simplement allez dans le linsting à l'endroit choisi, sans création de dossier,

Mais wouah pour cette macro, j'en aurais surement l'utilité un de ces jours!

Salut Willkaa,

Ca fait un bail ! . Je te remercie beaucoup pour ces voeux ! Je te souhaite à mon tour le meilleur pour cette nouvelle année qui je l'espère sera pour toi salutaire et au moins l'année de la concrétisation de tous les nombreux projets que tu entreprends !

Je regarderai ce que j'ai fait quand j'aurai un moment et donc tu ne veux pas de création de dossier et pointer vers le listing seulement (le dossier parent si je comprends bien ?) ?

Cdlt,

Merci à toi c'est très aimable!

Oui c'est cela au lieu de faire défiler les numéro je voudrais un petit raccourci en gros qui fait guise de répertoire,

Très bien merci j'attend ton retour

Re Willkaa,

Est-ce que tu peux me montrer le résultat que tu attends parce que, même après avoir jeté un coup d'oeil au fichier, je ne suis pas sûr de comprendre.

A bientôt,

Bonjour 3GB,

Voici en feuille 1 le résultat de ce que je souhaite, en espérant que ça te guide,

Re Willkaa,

Je regarde ça tout de suite

Ah oui, effectivement, ça n'avait rien à voir...

Tu sais, je pense que je vais bientôt t'appeler Mr Répertoire ou Mr Hypertexte

Voici le code et le fichier en retour :

Sub test_repertoire()

Dim dl&, i&, k%, vcherchee$

With Sheets("Répertoire")
    dl = .usedrange.rows.count
    For i = 3 To dl
        For k = 1 To 5
            If .Cells(i, k) <> "" Then
                vcherchee = .Cells(i, k).Value
                If Application.CountIf(Sheets("Listing matériel").Range("A:E"), vcherchee) > 0 Then
                    .Cells(i, k).Font.Color = xlNone
                    .Cells(i, k).Font.Underline = False
                    ancre = Sheets("Listing matériel").Cells.Find(what:=vcherchee, LookIn:=xlValues, lookat:=xlWhole).Address
                    .Cells(i, k).Hyperlinks.Add anchor:=.Cells(i, k), Address:="", SubAddress:="'Listing matériel'!" & ancre, TextToDisplay:=.Cells(i, k).Value
                Else
                    .Cells(i, k).Font.Color = 255
                    .Cells(i, k).Font.Underline = True
                End If
            End If
        Next k
    Next i
End With

End Sub

A bientôt,

J'aime bien la fluidité et la facilité à retrouver quelque chose plus facilement

Ah c'est presque parfait!!

Ce serai possible que ça marque toutes les valeurs des colonnes de "A" à "D" automatiquement?

Et que le lien ne s'arrêtes pas à la cellule mais à la longueur des caractères?

Désolé Mr Répertoire mais peux-tu préciser ta première demande ?

Est-ce que tu veux que je rajoute, sur le texte de chaque lien de la feuille Répertoire, la colonne visée sur la feuille Listing ?

Pour le second problème, je crois que ce n'est pas possible ou je ne connais pas le moyen d'y parvenir, à moins d'ajuster la largeur des colonnes. En fait, le lien est ancré sur un objet range, en l'occurrence une cellule ici (je ne sais pas si on peut ancrer un seul lien sur plusieurs cellules) et pas sur le texte qu'il affiche.

Au cas où :

Range("A:E").entirecolumn.autofit

En fait je pars d'une feuille vierge et sur cette feuille je voudrais extraire seulement les valeurs des colonnes de A à D de la feuille 'Listing Matériel' sans les lignes vides mais comme elles sont décalés je n'arrive pas a le faire via un tri

A moins que je trouve une formule en "E" qui dit " si valeur en "A" ou en "B" .."D" 1 sinon 0 et je tri de cette facon!

=SI(OU(A3;B3;C3;D3)="*";1;0)

Ah bah j'ai été dans supprimer les doublons et il m'a supprimé les lignes vides!