Lien hypertexte en VBA

[Laurent313131]

Bonjour le forum !

J'ai crée une USF qui apparaît quand je clique sur le bouton " Creer nouvel athlête" en page "Fiche athlête".

Ce que j'aimerais c'est qu'une feuille identique à la feuille "1" se crée automatiquement lorsque je crée un nouvel athlète en appuyant sur le bouton valider de cette USF.

De plus, il faudrait qu'un lien genre lien hypertexte se fasse entre cet l'athlète et sa feuille.
Ainsi, quand je clique sur son nom, cela me renvoie à sa feuille.

J'ai fais avec la méthode créer un lien hypertexte dans mon exemple, mais je voudrais rendre cette étape automatique.

Le fichier se trouve en pièce jointe. J'ai enlevé plein de codes et plein d'autres choses car le fichier était trop lourd...

Merci pour votre précieuse aide.

 

[pierrejean]

Re : Lien hypertexte en VBA

bonjour Laurent

Vois si cela te convient

 

[Laurent313131]

Re : Lien hypertexte en VBA

Merci pierrejean ! C'est exactement ce que je voulais

J'aimerais avoir 1% de tes connaissances en VBA lol

 

[alexga78]

Re : Lien hypertexte en VBA

bonjour Laurent313131, le forum

bon pierrejean est bien plus rapide que moi mais comme j'ai fait le boulot je poste quand même

'Fîche nouvel athlète
Private Sub CommandButton1_Click()
Dim Dl1 As Long
Sheets("1").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Application.Proper(TextBox1.Value)
With Sheets("Fiche athlète")
Dl1 = .Range("A65530").End(xlUp).Row + 1
.Range("A" & Dl1) = TextBox1.Value
ActiveSheet.Hyperlinks.Add Anchor:=.Range("A" & Dl1), Address:="", SubAddress:="'" & TextBox1.Value & "'!A1"
ActiveSheet.Cells(1, 1) = Application.Proper(TextBox1.Value)
.Columns(1).HorizontalAlignment = xlCenter
End With
Unload Me
Sheets("Fiche athlète").Select
End Sub
'Ferme Fiche athlête
Private Sub CommandButton2_Click()
Unload Fiche_athlète
End Sub

Bonne journée

 

[Laurent313131]

Re : Lien hypertexte en VBA

MErci alex ...

Dans 1 nouvelle textbox je voudrais rentrer une date de naissance au format JJ/MM/AAAA. Le code m'inscrit correctement ma date de naissance en A2, il copie la feuille "1" et crée le lien avec le nom du joueur mais il m'efface ma feuille athlète. Deplus, j'ai un message d'erreur qui apparaît :

Vous avez tapé un nom de feuille ou de graphique non valide. Vérifiez les points suivants :

Le nom ne dépasse pas 31 caractères.
LE nom ne contient aucun des caractères suivants : /\ ? * [ ou ]
LE champs du nom n'est pas vide.

J'ai surligné en rouge les lignes que j'ai ajouté..


Private Sub CommandButton1_Click()
Dim Dl1 As Long

'With Sheets("Fiche athlète")
Dl1 = Sheets("Fiche athlète").Range("a65536").End(xlUp).Row + 1
Sheets("Fiche athlète").Cells(Dl1, 1).Value = Fiche_athlète.TextBox1.Value
Sheets("Fiche athlète").Cells(Dl1, 2).Value = Fiche_athlète.TextBox2.Value
'Dl1 = Cells(31, 1).End(xlUp).Row + 1
'End With
Sheets("1").Copy After:=Sheets("Fiche athlète")
ActiveSheet.Name = Fiche_athlète.TextBox1.Value

ActiveSheet.Range("A1") = Fiche_athlète.TextBox1.Value
Sheets("Fiche athlète").Hyperlinks.Add Anchor:=Sheets("Fiche athlète").Cells(Dl1, 1), Address:="", SubAddress:= _
Fiche_athlète.TextBox1.Value & "!A1", TextToDisplay:=Fiche_athlète.TextBox1.Value
Sheets("Fiche athlète").Select

ActiveSheet.Name = Fiche_athlète.TextBox2.Value
ActiveSheet.Range("A2") = Fiche_athlète.TextBox2.Value
Sheets("Fiche athlète").Hyperlinks.Add Anchor:=Sheets("Fiche athlète").Cells(Dl1, 2), Address:="", SubAddress:= _
Fiche_athlète.TextBox2.Value & "!A2", TextToDisplay:=Fiche_athlète.TextBox2.Value
Sheets("Fiche athlète").Select

End Sub

 

[alexga78]

Re : Lien hypertexte en VBA

Re,
un essai en PJ.

bonne journée

 

[Laurent313131]

Re : Lien hypertexte en VBA

Merci !

Alors il n'y a plus de message d'erreur mais la date de naissance s'affiche en A2 dans la nouvelle feuille crée et non dans ma fiche athlète en B7, à côté de la colonne nom...

 

[alexga78]

Re : Lien hypertexte en VBA

RE,
désolé j'avais pas compris...le we mes neurones sont au repos.

.Range("A" & Dl1) = TextBox1.Value
[COLOR="Red"].Range("A" & Dl1).Offset(0, 1) = Format(TextBox2.Value, "dd/mm/yyyy")[/COLOR]

ajoute la ligne en rouge en dessous de l'autre
bonne journée

 

[Laurent313131]

Re : Lien hypertexte en VBA

Encore merci .

J'ai une dernière manip à ajouter ! Dans la USF, j'ai ajouté des options boutons...

Je voudrais que le choix que je fais quand je clique sur les boutons, s'inscrive dans ma feuille fiche athlète en colonne 3 et 4.

J'ai rajouté ces lignes dans mon code mais ça ne marche pas :

'Fîche nouvel athlète

Private Sub CommandButton1_Click()
Dim Dl1 As Long
Sheets("1").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Application.Proper(TextBox1.Value)
With Sheets("Fiche athlète")
Dl1 = .Range("A65530").End(xlUp).Row + 1
.Range("A" & Dl1) = TextBox1.Value
.Range("A" & Dl1).Offset(0, 1) = Format(TextBox2.Value, "dd/mm/yyyy")
.Range("E" & Dl1) = TextBox3.Value
ActiveSheet.Hyperlinks.Add Anchor:=.Range("A" & Dl1), Address:="", SubAddress:="'" & TextBox1.Value & "'!A1"
ActiveSheet.Cells(3, 1) = Application.Proper(TextBox3.Value)
ActiveSheet.Cells(1, 1) = Application.Proper(TextBox1.Value)
ActiveSheet.Cells(2, 1) = Format(TextBox2.Value, "dd/mm/yyyy")

.Columns(1).HorizontalAlignment = xlCenter

If Controls("OptionButton1").Value = True Then Cells(Dl1, 3).Value = "Cadet"
If Controls("OptionButton2").Value = True Then Cells(Dl1, 3).Value = "Junior"
If Controls("OptionButton3").Value = True Then Cells(Dl1, 4).Value = "Avant"
If Controls("OptionButton4").Value = True Then Cells(Dl1, 4).Value = "Meneur"
If Controls("OptionButton5").Value = True Then Cells(Dl1, 4).Value = "Trois/Quart"

End With
Unload Me
Sheets("Fiche athlète").Select
End Sub

 

[alexga78]

Re : Lien hypertexte en VBA

Re Laurent313131, le forum,

Regarde si ça te convient.
Bonne soirée et bon WE à tous

 

[Laurent313131]

Re : Lien hypertexte en VBA

Un très grand merci !!!!!!! C'est exactement ce que je voulais !

Je vais désormais essayer de comprendre ton code mais c'est pas gagné

Bonne soirée à toi aussi !