[RESOLU] Lien hypertexte avec variable

maxousurf

XLDnaute Nouveau
Bonjour à tous,

Dans le cadre de mon travail, je suis en train de réaliser un gros logiciel de suivi d'opérations.
J'ai réalisé actuellement une grande partie de l'interface et des codes sous VBA.

Je viens à vous parce que malgré mes nombreuses recherches sur internet, les forums et devant VisualBasic, je ne trouve pas la réponse à quelques questions.

Je vous explique rapidement.

Tout d'abord, le logiciel étant à caractère très professionnel, j'ai dû supprimer de nombreuses choses, l'essentiel reste là pour m'aider.

Alors, sur ma première feuille ("Nouveau"), on entre les données demandées. Ces dernières seront automatiquement listées ligne 400 de ma feuille "Liste des opérations" mais une macro les remettra en ordre chronologique en ligne 4.
De plus, la feuille "Modèle" sera dupliquée et renommée selon le numéro entré sur la feuille "Nouveau", cellule "C5".

C'est justement là mon soucis, j'aimerai que la macro créé un lien hypertexte sur ma feuille "Liste des opérations" portant le nom du numéro d'opération rentré sur la feuille "Nouveau" et faisant référence à la feuille créée portant ce même nom.

Je ne sais pas si je suis bien clair. Un exemple:

J'entre le numéro 122 dans ma première feuille, je clique sur "créer", j'aurai alors une nouvelle feuille "122" de créée et une nouvelle ligne dans "Liste des opérations".
J'aimerai du coup que dans "Liste des opérations", j'ai un lien hypertexte, qui quand je clique sur le numéro "122", ce dernier m'envoie à la feuille "122".

Mon problème ? Tout simplement que vu que je ne sais pas du tout quel numéro je peux entrer, je fonctionne uniquement avec des variables, mais les variables sont effacées à la fin.

Auriez-vous une solution ?


Voici mon code de création:

Code:
Sub nouveau()
'
' nouveau Macro
'

'
    nom = Sheets("Nouveau").Range("C5:D5")
    année = Sheets("Nouveau").Range("C14:D14")
    opération = Sheets("Nouveau").Range("C5:D5")
    commune = Sheets("Nouveau").Range("C6:E6")
    loca = Sheets("Nouveau").Range("C7:E7")
    secteur = Sheets("Nouveau").Range("C8:E8")
    agent = Sheets("Nouveau").Range("C9:D9")
    descri = Sheets("Nouveau").Range("C10:H12")
    cout = Sheets("Nouveau").Range("C13:D13")
    
    Sheets("Liste des opérations").Select
    Range("B400").Select
    ActiveCell.FormulaR1C1 = commune
    Range("C400").Select
    ActiveCell.FormulaR1C1 = secteur
    Range("D400").Select
    ActiveCell.FormulaR1C1 = loca
    Range("E400").Select
    ActiveCell.FormulaR1C1 = descri
    Range("F400").Select
    ActiveCell.FormulaR1C1 = année
    Range("G400").Select
    ActiveCell.FormulaR1C1 = cout
    Range("K400").Select
    ActiveCell.FormulaR1C1 = agent
    Range("A400").Select
    ActiveCell.FormulaR1C1 = opération
    
    Range("A4:A399").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("B4:B399").Select
    Selection.Font.Bold = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("C4:C399").Select
    Selection.Font.Bold = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("D4:D399").Select
    Selection.Font.Bold = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("E4:E399").Select
    Selection.Font.Bold = False
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Rows("4:399").EntireRow.AutoFit
    
    Range("F4:F399").Select
    Selection.Font.Bold = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("G4:G399").Select
    Selection.Font.Bold = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("H4:H399").Select
    Selection.Font.Bold = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("I4:I399").Select
    Selection.Font.Bold = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("J4:J399").Select
    Selection.Font.Bold = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("K4:K399").Select
    Selection.Font.Bold = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("L4:L399").Select
    Selection.Font.Bold = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("M4:M399").Select
    Selection.Font.Bold = False
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Sheets("Modèle").Select
    Sheets("Modèle").Copy Before:=Sheets(2)
    Sheets("Modèle (2)").Select
    ActiveSheet.Name = Sheets("Nouveau").Range("C5")
    Range("J19").Select
    Range("E6").Select
    ActiveCell.FormulaR1C1 = année
    Range("D7:G7").Select
    ActiveCell.FormulaR1C1 = opération
    Range("D9:G9").Select
    ActiveCell.FormulaR1C1 = commune
    Range("D10:G10").Select
    ActiveCell.FormulaR1C1 = secteur
    Range("D11:G11").Select
    ActiveCell.FormulaR1C1 = loca
    Range("D13:G13").Select
    ActiveCell.FormulaR1C1 = agent
    Range("D15:G15").Select
    ActiveCell.FormulaR1C1 = descri
    Range("D18:G18").Select
    ActiveCell.FormulaR1C1 = cout
    Range("D19:G19").Select
    Sheets("Nouveau").Select
    Range("C14:D14").Select
    Selection.ClearContents
    Range("C13:D13").Select
    Selection.ClearContents
    Range("C10:H12").Select
    Selection.ClearContents
    Range("C9:D9").Select
    Selection.ClearContents
    Range("C8:E8").Select
    Selection.ClearContents
    Range("C7:E7").Select
    Selection.ClearContents
    Range("C6:E6").Select
    Selection.ClearContents
    Range("C5:D5").Select
    Selection.ClearContents
    
End Sub

Je vous poste déjà cette question là avant de vous demander de l'aide pour la suite (que je continue toujours à chercher d'ailleurs).

Un grand merci d'avance pour votre aide et n'hésitez pas pour avoir de plus amples informations :)
 

Pièces jointes

  • Logiciel.xlsm
    71.5 KB · Affichages: 45
  • Logiciel.xlsm
    71.5 KB · Affichages: 47
  • Logiciel.xlsm
    71.5 KB · Affichages: 43
Dernière édition:

john

XLDnaute Impliqué
Re : Lien hypertexte avec variable

Bonjour,

voir le fichier ci-joint :)

BàT.

John

Ps: serai bien d'éviter les accents dans les variables :)
 

Pièces jointes

  • Logiciel.xlsm
    77.1 KB · Affichages: 46
  • Logiciel.xlsm
    77.1 KB · Affichages: 54
  • Logiciel.xlsm
    77.1 KB · Affichages: 48

maxousurf

XLDnaute Nouveau
Re : Lien hypertexte avec variable

Super ! Ca marche très bien :)
Par contre, il y a un petit soucis, j'ai testé avec le chiffre 550 par exemple, tout en laissant la ligne 122, et bien le lien hypertexte ne se met pas. En fait j'ai remarqué que ta macro mettait le lien uniquement pour la première ligne, or j'aimerai qu'il me le mette pour chaque ligne ajoutée. Je ne sais pas si tu vois ce que je veux dire ?

En tout cas déjà ça marche très bien ! :) Je pense que tu n'auras pas de mal à résoudre ce petit problème vu la rapidité avec laquelle tu m'as donné une solution :)

Ps: merci pour l'info, je tâcherai d'y remédier :)
 

john

XLDnaute Impliqué
Re : Lien hypertexte avec variable

re,

ajoute la ligne qui est entre '------------------- dans la partie qui suit

If Range("A" & x).Value = operation Then
'-------------------------
Range("A" & x).Select
'---------------------------
Range("A" & x).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"'" & operation & "'" & "!A1"
End If

BàT

John
 

maxousurf

XLDnaute Nouveau
Re : Lien hypertexte avec variable

C'est parfait ! Merci beaucoup beaucoup pour ton aide ! :)

J'aurai une autre question, j'aimerai suite aux liens hypertextes, avoir la possibilité de masquer les feuilles (ex. 122 etc.). Mais que, quand je clique sur le lien de "Liste des opérations", la feuille s'affiche.
Je n'ai pas réussi à trouver s'il y avait moyen, quelqu'un aurait une solution ?
 

john

XLDnaute Impliqué
Re : Lien hypertexte avec variable

Bonjour,

tu dois mettre sheets(X).visible=false pour la cacher ' X est le numéro de la feuille ou avec le nom de la feuille, mais alors entre "" et pour l'afficher pareil mais = true

Si tu n'y arrives pas, crie fort et on vient :)

BàT
 

maxousurf

XLDnaute Nouveau
Re : Lien hypertexte avec variable

Merci John, ça j'avais vu avec l'enregistreur de macro.

Le soucis c'est que si tu veux, mes fiches seront cachées de base et en fait, j'aimerai avoir la possibilité, en cliquant sur le lien hypertexte, réafficher la feuille, mais ça ne marche pas (en gros il ne me la trouve pas).

Du coup ayant besoin de votre aide à tous, je crie ! "ahhhhhh" :)
 

Pierrot93

XLDnaute Barbatruc
Re : Lien hypertexte avec variable

Bonjour,

regarde peut être ceci, à utiliser dans le module de la feuille où se trouve le lien :
Code:
Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Sheets("Feuil2").Visible = xlSheetVisible
Target.Follow
End Sub

bon après midi
@+
 

Pierrot93

XLDnaute Barbatruc
Re : Lien hypertexte avec variable

Re,

un code un peu plus élaboré si plusieurs liens et évite de boucler sur l'événement... :
Code:
Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim a() As String
With Target
    a = Split(.SubAddress, "!")
    Sheets(a(0)).Visible = xlSheetVisible
    Application.Goto Sheets(a(0)).Range(a(1))
End With
End Sub
 
Dernière édition:

maxousurf

XLDnaute Nouveau
Re : Lien hypertexte avec variable

Salut Pierrot,

Tout d'abord, merci pour ton aide. Alors j'ai essayé ton code, je l'ai inséré dans la feuille "Liste des opérations" puis j'ai ensuite masqué une feuille et cliqué sur le lien associé, mais le code bug. La feuille ne se ré-affiche pas :/
 

maxousurf

XLDnaute Nouveau
Re : Lien hypertexte avec variable

Ah beh j'ai essayé le deuxième, je n'ai pas dû faire ce qu'il fallait.
Donc, j'insère le code dans "Liste des opérations" et quand ma fiche est caché, si je clique sur le lien hypertexte, la feuille doit s'afficher, or, quand j'ai essayé ça ne marchait pas.

Après j'ai déjà un code dans cette feuille, celui-ci:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then

Range("A4:M400").Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

End If

End Sub

J'ai rajouté le tien à la suite mais je suppose qu'il vaut mieux les combiner ?
 

maxousurf

XLDnaute Nouveau
Re : Lien hypertexte avec variable

Voila le code de ma feuille "Liste des opérations":
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then

Range("A4:M400").Select
    Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
   
    End If
    
End Sub

Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim a() As String
With Target
    a = Split(.SubAddress, "!")
 ====>   Sheets(a(0)).Visible = xlSheetVisible
    Application.Goto Sheets(a(0)).Range(a(1))
End With
End Sub

La flèche montre l'endroit du bug.

Je ne comprends pas du tout pourquoi ça ne marche pas
 

Statistiques des forums

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