Discussion :

[throd]

Bonjour à tous,

J'ai commencé à me former en autodidacte sur les macros depuis peu, mais j'ai réussi à les finaliser. Cependant, je cherche à créer une macro permettant de créer une feuille chaque fois que la colonne "Mis en place" est renseigné par un "Oui" sous la condition que la feuille n'existe pas déjà :

Code :

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

1
2
3
4
Function FeuilExiste(F As String) As Boolean
    On Error Resume Next
    FeuilExiste = Not sheets(F) Is Nothing
End Function

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
24
25
26
27
28
29
30
31
32
33
Sub test()
 
Set ws1 = Worksheets("Sommaire scénarios")
Set ws2 = Worksheets("Menu")
 
Application.ScreenUpdating = False
 
ws1.Activate
 
Derncol = Range("D4").End(xlDown).Row
NbAjout = 0 
 
For I = 4 To Derncol
 Dim Feuil As String
 
If ws1.Cells(I, 7) = "Oui" Then
 
   Feuil = "T_" & Mid(ws1.Cells(I, 4), 1, 29)
 
   If FeuilExiste(Feuil) Then
    GoTo 9999
   End If
 
 
    sheets.Add After:=sheets(sheets.Count)
        sheets(sheets.Count).Select
        sheets(sheets.Count).Name = "T_" & Mid(ws1.Cells(I, 4), 1, 29)
End if
 
9999
Next
 
End sub

Suite à quoi je viens créer une forme dans la feuille "Menu" avec deux formes supplémentaires "Fichier trace" et "Analyse" en précisant leurs variables et une borne pour continuer dans le bas de feuille au lieu de s'étendre sur la droite.

Jusque là, tout fonctionne, le problème arrive dès le moment où je cherche à ajouter un lien hypertexte à la forme "Fichier trace" suite à la création de la feuille correspondante ce qui me donne le code suivant :

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
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, y, Z, 107.325, _
75).Select
B = Selection.Name
With Selection.ShapeRange
.ShapeStyle = msoShapeStylePreset22
 
    With .TextFrame2
    .VerticalAnchor = msoAnchorMiddle
    .TextRange.Characters.Text = "Fichier trace"
    .TextRange.Characters(1, 12). _
         ParagraphFormat.Alignment = msoAlignCenter
    .TextRange.Font.Size = 14
    .TextRange.Font.Bold = True
 
 
    End With
 
a = sheets("T_" & Mid(ws1.Cells(I, 4), 1, 29)).Name
 
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(B), Address:="", SubAddress:=a & "!A1", TextToDisplay:="Fichier trace"
End With

Un lien hypertexte est bel et bien crée mais lorsque j'essaie de cliquer dessus cela me met une erreur "Référence non valide" sans pour autant me mettre de message d'erreur lors du lancement de la macro.

Auriez-vous une solution à mon problème pour que le lien se rattache correctement à la feuille créer ?

PS : Désolé si c'est peu compréhensible mais j'ai essayé de faire au mieux dans la présentation du code (je n'ai pas trouvé comment l'insérer autrement) et également si ce code vous paraît catastrophique

En vous remerciant par avance,
Bonne journée à vous

[Fab_de_chez_PERFORM]

Hello
j'ai un code qui capte la cellule et la feuille de départ pour y créer un lien hypertexte vers A1 d'une nouvelle feuille créé (nommée lors de l'execution de la macro)
ca répond peut être pas 100% au besoin mais ca peut donner des idées

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
Sub Macro1()
'
' Macro1 Macro
'
 
Dim Ma_feuille As String
Dim Ma_cellule As String
Ma_feuille = ActiveSheet.Name
Ma_cellule = ActiveCell.Address
 
 
Dim Nouv_Feuil As String
Nouv_Feuil = InputBox("Nom de la nouvelle feuille")
 
Sheets.Add.Name = Nouv_Feuil
 
Sheets(Ma_feuille).Select
Range(Ma_cellule).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=Nouv_Feuil & "!A1", TextToDisplay:="texte à afficher"
 
End Sub

[throd]

Merci ! Je teste ça dès mon retour au travail 😃

[throd]

Bonjour,

J'ai tenté d'adapter ce que vous m'avez apporté comme base, mais un problème persiste : comment insérer le lien hypertexte dans une forme nouvellement créer ? Actuellement, j'ai ceci :

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
 
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, y, Z1, 107.325, _
75).Select
D = Selection.Name
C = sheets("A_" & Mid(ws1.Cells(I, 4), 1, 29)).Name
With Selection.ShapeRange
.ShapeStyle = msoShapeStylePreset22
    With .TextFrame2
    .VerticalAnchor = msoAnchorMiddle
    .TextRange.Characters.Text = "Analyse"
    .TextRange.Characters(1, 7). _
         ParagraphFormat.Alignment = msoAlignCenter
    .TextRange.Font.Size = 14
    .TextRange.Font.Bold = True
 
    End With
Application.DisplayAlerts = True
 
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange(D), Address:="", SubAddress:=C & "!A1", TextToDisplay:="Analyse"

Je n'arrive pas à savoir comment lui dire d'ajouter le lien hypertexte à la forme et non à une cellule. Un lien hypertexte se crée, mais lorsque j'essaie de cliquer dessus cela m'affiche "Référence non valide"

En vous remerciant par avance,

[Fab_de_chez_PERFORM]

Salut
je pense que ca vient du fait qu'il y a des espaces dans le noms des feuilles

voilà ma macro adaptée pour les formes et pour intégrer d'eventuels espaces dans le nom des feuilles

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
24
25
26
27
28
29
30
31
32
Sub Macro10()
 
Dim Ma_feuille As String
Ma_feuille = ActiveSheet.Name
 
Dim Nouv_Feuil As String
Nouv_Feuil = InputBox("Nom de la nouvelle feuille")
Dim Nouv_Forme As String
Nouv_Forme = InputBox("Texte de la nouvelle forme")
 
 
Sheets.Add.Name = Nouv_Feuil
 
Sheets(Ma_feuille).Select
 
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 207, 30.6, 177.6, 77.4).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Nouv_Forme
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
 
'verif si espace dans le nom de la nouvelle feuille
Dim Lien As String
If Len(Nouv_Feuil) = Application.Substitute(Nouv_Feuil, " ", "") Then
    Lien = Nouv_Feuil & "!A1"
Else
    Lien = "'" & Nouv_Feuil & "'!A1" 'avec apostrophes pour le nom de la feuille
End If
 
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:="", SubAddress:=Lien
 
 
End Sub

[throd]

ça marche ! Merci énormément pour ton aide

Bonne journée à toi