Creation de shapes sur une ligne temps

[erics83]

Bonjour,

Je souhaite mettre des shapes sur une ligne temps :

J'ai des "fiches actions", que je crée et remplie via un Userform. Dans ces fiches actions, il y a la date de l'action et des périodes d'anticipation. Par exemple : un forum des associations : programmé le 23 avril. donc je prévois des réunions préparatoires à différentes dates (=anticipation).
Sur mon fichier test, j'ai mis des "zones texte" avec le nom de l'action et une "barre" qui montre le positionnement sur une ligne temps (ici de mars à mai). J'aimerai que cela se fasse automatiquement....j'ai regardé un peu à droite et à gauche, notamment sur le blog de JB et apparemment cela pourrait être possible via des shapes...et aussi qu'en cliquant sur ces shapes, le Userform s'ouvre avec tout le descriptif de l'action...

Mais....je n'y arrive pas....(naturellement il y a plus que 4 actions...)

Une petite aide et/ou pistes ?
En vous remerciant

 

[erics83]

Bonjour,

Après différents essais, j'ai pu créer la "barre" sur la ligne temps...mais j'ai toujours un problème avec mes shapes qui ne veulent pas se mettre "au dessus" de la barre...le code :

Sub essai()
Dim i As Long
Dim j As Long

'---------------------------
'efface
With Feuil1.Columns("C:CP")
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With

Feuil1.Shapes.SelectAll
Selection.Delete

'Remet bouton action
With Feuil1.Buttons.Add(1.8, 1.2, 119.4, 16.8)
    .OnAction = "nouvelleaction"
    .Characters.Text = "Nouvelle Action"
    With .Characters(Start:=1, Length:=15).Font
        .Name = "Calibri"
        .FontStyle = "Normal"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
End With

'------------------------
For k = 6 To 18 Step 6 'boucle sur type action

For i = 2 To Feuil2.Range("A" & Rows.Count).End(xlUp).Row 'boucle sur BD

For j = 3 To Feuil1.Cells(4, Cells.Columns.Count).End(xlToLeft).Column 'boucle sur dates

'identification dates actions
If (Feuil1.Cells(k, 1) = Feuil2.Cells(i, 2) And Feuil1.Cells(4, j) = Feuil2.Cells(i, 13)) Then

'encadre
With Feuil1.Range(Cells(k - 1, j), Cells(k + 1, j))
.BorderAround Weight:=xlThin
End With

'Shapes
'Shapes
Feuil1.Shapes.AddTextbox(msoTextOrientationHorizontal, j * 6, k * 6, 50, 20).Name = "monshape" & Feuil2.Cells(i, 3).Value
  With ActiveSheet.Shapes("monshape" & Feuil2.Cells(i, 3).Value)
    .TextFrame.Characters.Text = Feuil2.Cells(i, 3).Value
   
    .Fill.ForeColor.RGB = RGB(255, 255, 0)
    .TextFrame.Characters.Font.Size = 8
   
   End With
End If

End If

Next
Next
Next

End Sub

Merci pour votre aide,

 

[erics83]

Bonjour,

J'avance toujours et encore....comme je n'avais pas de réponses et/ou pistes sur les shapes....j'ai regardé avec les commentaires et....je me souviens pourquoi je souhaitais passer par des shapes qui pouvaient éviter de se superposer (enfin d'après ce que j'avais compris...)....car les commentaires, voici ce que ça donne

Merci pour votre aide,