Creation de shapes sur une ligne temps

erics83

XLDnaute Impliqué
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
 

Pièces jointes

  • Classeur test Eric pour shape et ligne temps.xlsm
    29.1 KB · Affichages: 51
Dernière édition:

erics83

XLDnaute Impliqué
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 :
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

XLDnaute Impliqué
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

problèmeshape.png


Merci pour votre aide,
 

Discussions similaires

Réponses
1
Affichages
383
Réponses
8
Affichages
355

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou