Discussion :

[Cadet69]

Bonsoir à tous,

A l'aide d'un double clic sur une cellule de la colonne A de la feuille1 de mon classeur, j’ouvre une macro qui va créer une nouvelle feuille(x).
Au moment de la création de la nouvelle feuille(x), comment faire pour créer un lien Hypertext entre la cellule active et cette nouvelle feuille(x).

Voici le code, placé dans ma feuille1, qui est lancé par le double clic :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Lance le userform après le doubleclic sur une des cellules de la colonne A
    If Not Application.Intersect(Target, Range("A3:A2002")) Is Nothing Then
    Cancel = True
    Call selectionnepatientepourdossiergross
    End If
    End Sub

Voici le code, également placé dans ma feuille1, qui gère les infos du userform2 lancé par le double clic :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    UserForm2.TextBox1.Text = ActiveCell.Value
    'If Selection.Column > 1 Then
    'MsgBox "------------------------------------ ERREUR ------------------------------------ Maintenant faire OK et aller cliquer obligatoirement dans la colonne des N°:SS"
    'End If
    UserForm2.TextBox2.Text = ActiveCell.Offset(0, 2).Value     'Nom
    UserForm2.TextBox3.Text = ActiveCell.Offset(0, 3).Value     'Prénom
    UserForm2.TextBox4.Text = ActiveCell.Offset(0, 4).Value     'Date de naissance
    UserForm2.TextBox5.Text = ActiveCell.Offset(0, 6).Value     'Numéro (dans la rue)
    UserForm2.TextBox6.Text = ActiveCell.Offset(0, 7).Value     'Intitulé (rue, place, boulevard etc..)
    UserForm2.TextBox7.Text = ActiveCell.Offset(0, 8).Value     'Nom de la rue
    UserForm2.TextBox8.Text = ActiveCell.Offset(0, 9).Value     'Code postal
    UserForm2.TextBox9.Text = ActiveCell.Offset(0, 10).Value    'Nom de la ville
    UserForm2.TextBox10.Text = ActiveCell.Offset(0, 5).Value    'Âge calculé
    UserForm2.TextBox11.Text = Range("D1")                      'Date du jour de création du dossier médical de grossesse
 
End Sub

Et voici le code, placé lui dans le userform2, qui va chercher mon modèle et qui copie les infos des textbox aux bons endroits.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub CommandButton1_Click()
 
    Sheets.Add After:=Sheets(Sheets.Count), Type:="C:\Users\papa\AppData\Roaming\Microsoft\Templates\Modèle pour consultation.xltm"
 
    Range("C5").Value = UserForm2.TextBox11.Text
    Range("B9").Value = UserForm2.TextBox1.Text
    Range("B10").Value = UserForm2.TextBox2.Text
    Range("G10").Value = UserForm2.TextBox3.Text
    Range("K9").Value = UserForm2.TextBox4.Text
    Range("K10").Value = UserForm2.TextBox10.Text
    Range("B12").Value = UserForm2.TextBox5.Text & ", " & UserForm2.TextBox6.Text & " " & UserForm2.TextBox7.Text & " - " & UserForm2.TextBox8.Text & " - " & UserForm2.TextBox9.Text
 
    Sheets("Modèle consult").Name = Range("b10") & Format(Date, " dd-mm-yyyy") 'Détermine le nom de la feuille copiée
 
    Unload Me
 
End Sub

J'ai donc juste besoin de coller un lien hypertexte entre Activecell et A1 de la feuille(x) créée.

Si vous pouvez me donner un petit coup de main, je vous en remercie par avance.
Cordialement.

[Docmarti]

Bonjour

J'ai donc juste besoin de coller un lien hypertexte entre Activecell et A1 de la feuille(x) créée.

Ceci semble faire ce que tu souhaites :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub CommandButton1_Click()
 
Dim fOrigine As Object
Dim NouvelleFeuille As Object
Dim CelluleActive As Range
Dim CelluleDestination As String
 
Set fOrigine = ActiveSheet
Set CelluleActive = ActiveCell
 
Set NouvelleFeuille = Sheets.Add(After:=Sheets(Sheets.Count), Type:="C:\Users\papa\AppData\Roaming\Microsoft\Templates\Modèle pour consultation.xltm")
'Set NouvelleFeuille = Sheets.Add(After:=Sheets(Sheets.Count))
 
CelluleDestination = "A1"
 
fOrigine.Hyperlinks.Add Anchor:=CelluleActive, _
              Address:="", _
              SubAddress:="'" & NouvelleFeuille.Name & "'!" & CelluleDestination, _
              TextToDisplay:=CStr(CelluleActive.Value)
 
fOrigine.Activate
 
End Sub

[Citrax]

Bonjour,

C'est interessant, j'ai eu le meme genre de demande il y a quelques semaines.
Mais mon fichier qui utilise aussi le double clic procede sans userform et sans bouton de commande.
Je ne vois a ce sujet pas a quoi sert ton "Private Sub Worksheet_BeforeDoubleClick" puisque le bouton de commande gere tout !?


Peut etre que cette solution plus simplette je te l'accorde peut egalement te convenir : Placement de lien hypertexte


Sinon il y a ici de quoi potasser sur les userforms.


NB: Si cela ne te derange pas, serait-il possible d'avoir une version anonymisée et vierge de ton classeur svp, j'aimerais voir une autre approche que la mienne.
Cordialement

NB2: merci a Docmarti, sa commande est excellente et tres parfaitement simple a la fois.

[Cadet69]

Bonjour à vous,

Merci Docmarti pour ta proposition que je vais tester dès que possible, après quoi je te tiendrais évidemment au parfum.
Citrax, pas de problème pour te donner une copie de mon classeur mais, en l’occurrence, il ne se suffit pas à lui tout seul car mon userform2 récupère un modèle que j'ai crée.
Il faut donc te donner les deux fichiers, dont le modèle, que tu devras placer sous C:\Users\xxxxxxx\AppData\Roaming\Microsoft\Templates\ (remplacer les xxxx par le bon nom ou les supprimer).

Je m'en occupe dès que possible.

Cordialement.

[Cadet69]

Encore bonsoir à vous,

Je reviens pour dire à Docmarti que sa solution fonctionne parfaitement.
J'ai juste eu à légèrement modifier le code de mon commandButton1 et voila que tout marche, c'est magique, encore merci.

Pour Citrax voici mon fichier dans lequel je n'ai laissé que 2 contacts fictifs pour l'exemple.
En revanche, la gestion du forum limite, logiquement, la divulgation de certains fichiers et le modèle que j'utilise n'a pas été accepté.
J'ai donc seulement créé une feuille à partir du modèle avec un double-clic sur le N°:SS (mais tu ne pourras pas le faire sauf à créer un autre modèle)
En bref il s'agit juste d'une Bd de patientes à laquelle j'ai ajouté la possibilité de création automatique de fiches personnalisées.
Ces fiches sont pré remplies par EXCEL et le praticien fait le reste.
Puis, à l'aide d'une macro, j'imprime ET j'enregistre la fiche en pdf au bon endroit.
Il y a une notice, au cas ou.

Voila, tout.
Merci pour tout.