Discussion :

[jonhza]

Bonjour, étant jeune étudiant, j'ai commencé à travailler VBA, mais je suis encore débutant et j'ai un travail consistant à créer un planning dynamique sous VBA : j'ai déjà créé un userform, associé à un bouton, qui permet d'afficher les tâches, les pôles concernés, et la date de début et de fin de ces tâches.

Mon exercice consiste à faire en sorte que losrque je rentre une tâche, automatiquement une shape se créera sur l'autre feuille ( le planning), qui débutera et se terminera aux dates concernées.

Par exemple, si j'entre une tâche qui va du 15 janvier au 15 février, la shape devra se situer au milieu du mois de janvier et aller jusqu'au mois de février, et correspondra bien sûr au pôle chargé de la tâche

Là est mon problème : si j'arrive à avoir la bonne longueur pour ma shape, elle ne se place jamais au bon mois, et ce malgré y avoir réfléchi longtemps.

JE ne sais pas si j'ai été clair, mais j'espère que quelqu'un pourra m'aider.
Je laisse le fichier en question joint à mon message, en vous remerciant d'avance de votre aide.

[78chris]

Bonjour

Pour ce type de problématique on utilise plutôt des mises en forme conditionnelles sur les cellules du planning car les shapes, outre la difficulté de placement, de taille, de mise à jour, alourdissent le classeur.

[PMO2017]

Bonjour,

Essayez avec ce code modifié (voir les ###)

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Private Sub Valider_Click()
Dim i As Long
 
Dim j As Long
 
Dim l As Single, t As Single, h As Single, w As Single
nb_ligne = Inputs.Cells(Rows.Count, 1).End(xlUp).Row
 
If IsNumeric(Projet) = True Then
    MsgBox ("Entrez un nom de projet")
    Exit Sub    '##########
Else
    Inputs.Cells(nb_ligne + 1, 1).Value = Projet.Value
 
End If
 
Inputs.Cells(nb_ligne + 1, 2).Value = Début.Value
Inputs.Cells(nb_ligne + 1, 3).Value = Fin.Value
Inputs.Cells(nb_ligne + 1, 4).Value = ListBox1.Value
 
 
'i = Fin.Value - Début.Value
'j = Début.Value - DateSerial(Year(Date), 1, 1)
'If ListBox1.Value = Range("Q2").Value Then
'    h = Range("C4").Height * 3
'    w = Range("C4").Width * i / 7
'    l = Range("C4").Left * j / 7
'    t = Range("C4").Top
 
 
 
'####################
Dim S As Worksheet
Dim R As Range
Dim SH As Shape
Dim TB As Excel.TextBox
Dim var As Variant
Dim ColDeb&
Dim ColFin&
Dim RowPole&
'---
Set S = Worksheets("Feuil1")
'--- Recherche des colonnes des semaines ---
With Application.WorksheetFunction
  ColDeb& = .WeekNum(Début, 2) + 2  '+2 pour les colonnes A et B non concernées
  ColFin& = .WeekNum(Fin, 2) + 2    '+2 pour les colonnes A et B non concernées
End With
'--- Recherche de la ligne du Pôle ---
var = S.UsedRange
For i = 1 To UBound(var, 1) 'Nb de lignes
  If var(i, 1) = ListBox1 Then
    RowPole& = i
    Exit For
  End If
Next i
'--- Le range concerné ---
Set R = S.Range(S.Cells(RowPole&, ColDeb&), S.Cells(RowPole&, ColFin&))
'--- Construction de la Shape
Set SH = S.Shapes.AddTextbox(msoTextOrientationHorizontal, R.Left, R.Top, R.Width, R.Height)
Set TB = SH.OLEFormat.Object
With TB
  .Characters.Text = Projet.Value
  .HorizontalAlignment = xlCenter
  .VerticalAlignment = xlCenter
  .Interior.Color = vbCyan
End With
'###################
 
 
Unload NouveauProjet
'Range("F10").Activate
End Sub

[Invité]

Bonjour,

Une autre solution possible dans le fichier joint.

Nb: Je suis d'accord avec Chris, cela risque d'être la galère si les colonnes, les lignes ou les dimensions changent. Dans ce cas, il faudrait faire un raz sur tous les shapes et tout reconstruire à chaque fois avec une boucle.

Cordialement.

[jonhza]

Tout d'abord, merci d'avoir répondu si rapidement : PMO2017, oui cela fonctionne, mais le problème, c'est que je souhaitais que les shapes s'affichent à la cellule correspondant au début de la tâche et ici cela affiche la shape sur tout le mois, et je ne parviens plus à faire en sorte que cela corresponde.

Monsieur Kergresse : merci beaucoup, ça correspond à ce que j'avais en tête pour la planning, mais étant débutant en VBA je ne comprends pas la plupart des lignes de code, et je ne serai pas capable de le refaire, mais merci !

Est-ce que l'un d'entre vous a compris pourquoi ma façon de faire ne fonctionne pas :

Code :

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

1
2
3
4
5
6
7
i = Fin.Value - Début.Value
j = Début.Value - DateSerial(Year(Date), 1, 1)
If ListBox1.Value = Range("Q2").Value Then
    h = Range("C4").Height * 3
    w = Range("C4").Width * i / 7
    l = Range("C4").Left * j / 7
    t = Range("C4").Top

Pourquoi est-ce que l'écart par rapport à la gauche est si disproportionné ? Pourquoi mes shapes ne se créent pas à l'endroit de début de ma tâche ?

En vous remerciant de vos réponses.

[geogeo70]

Bonjour,

J'ai un peu travaillé sur votre problème :

qques propositions :

-votre souci de position semble être l'oubli des deux cellules de début!

x = Range(r).Width
h = Range(r).Height * 3
w = x * i / 7
l = x * j / 7 + 2 * x 'oubli des cellules vides!!
t = Range(r).Top

-plutôt utiliser les controlsources pour la saisie des valeurs...

ex : ListBox1.RowSource = "Inputs!Q2:Q12"

-plutôt contrôler les saisies dans les "événements xxxx_change()

ex : Private Sub Projet_Change()
<ici les contrôles>
End Sub

mes propositions de source :

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Private Sub UserForm_Initialize()
 
Dim nb_ligne As Integer
 
Inputs.Activate
ListBox1.RowSource = "Inputs!Q2:Q12"
If Range("A3") = "" Then nb_ligne = 2 Else nb_ligne = Inputs.Range("A2").End(xlDown).Row
Projet.ControlSource = "Inputs!A" & CStr(nb_ligne + 1)
debut.ControlSource = "Inputs!B" & CStr(nb_ligne + 1)
fin.ControlSource = "Inputs!C" & CStr(nb_ligne + 1)
'Changement des sources...
 
End Sub
 
Private Sub Valider_Click()
Dim i As Integer
 
Dim j As Integer
 
Dim l As Single, t As Single, h As Single, w As Single
Dim nb_ligne As Integer   'declaration
Dim r As String
Dim rr As Range
Dim x As Integer
nb_ligne = Inputs.Range("A2").End(xlDown).Row
 
If IsNumeric(Projet) Or Projet = "" Then   'isnumeric est booleen donc inutile =true
 
    MsgBox ("Entrez un nom de projet")      ' plutôt tester à la saisie pour corriger avant
 
'Else
'    Inputs.Cells(nb_ligne + 1, 1).Value = Projet.Value
 
End If
'suprimer les lignes les saisies se font en direct
 
Inputs.Cells(nb_ligne, 4).Value = ListBox1.Value
'plus besoin de +1 le projet est déjà saisi!
 
i = CDate(fin.Value) - CDate(debut.Value)  'texte en date
j = CDate(debut.Value) - DateSerial(Year("1/1/2014"), 1, 1)
 
Select Case ListBox1.Value   'selection du pôle
 Case Inputs.Range("Q2")
    r = "C4"
 Case Inputs.Range("Q3")
    r = "C12"
 Case Inputs.Range("Q4")
    r = "C20"
 Case Inputs.Range("Q5")
    r = "C28"
End Select
     x = Range(r).Width
     h = Range(r).Height * 3
     w = x * i / 7
     l = x * j / 7 + 2 * x   'oubli des cellules vides!!
     t = Range(r).Top
 
    Worksheets("Feuil1").Activate
 
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, l, t, w, h).Select
 
    With Selection
        .Characters.Text = Projet.Value
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
 
 
 
Unload NouveauProjet
Range("F10").Activate
End Sub

ci-joint le fichier : TD EXCEL2.xlsm

bonne année


geogeo70

[Philippe Tulliez]

Bonjour,
L'utilisation du VBA est-il impératif car comme l'a très justement relevé Chris que je salue au passage une simple mise en forme conditionnelle peut faire l'affaire.
J'ai développé une gestion de planning pour des travaux en utilisant juste deux fonctions personnalisées et encore parce-que j'avais la flemme de créer trop de formules imbriquées.
Fais une recherche sur "Excel & Diagramme de Gantt" et tu auras une multitude d'exemple et notamment de Pierre Fauconnier Excel :Créer diagramme de Gantt grâce à un graphique Excel

[geogeo70]

J'ai d'abord fait une macro qui place précisément les mois/semaines :

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
34
35
36
37
38
39
40
41
42
43
44
Sub calclongmois()
 
Dim col As Integer, lmois As Double
Dim h As Double, w As Double, l As Double, t As Double
Dim jmois As Integer, jdep As Date, diff As Integer
Dim i As Integer, j As Integer, k As Integer
 
 
 
diff = Weekday(DateSerial(Planning.Cells(1, 1), 1, 1), vbMonday)
jdep = DateSerial(Planning.Cells(1, 1), 1, 1)
 
lmois = 0
For i = 1 To 12   'placement des 12 mois
If i <> 12 Then
  jmois = DateSerial(Planning.Cells(1, 1), i + 1, 1) - jdep   'calcul du nb de jours/mois
           Else
  jmois = DateSerial(Planning.Cells(1, 1) + 1, 1, 1) - jdep    'dernier mois
End If
jdep = DateSerial(Planning.Cells(1, 1), i + 1, 1)   'départ
With Planning.Range("A1")
     col = .Width
     h = .Height
     w = jmois * col / 7
     l = 2 * col - (diff * col / 7) + lmois   'le premier n'est pas souvent un lundi!!!!
     t = .Top
     lmois = lmois + jmois * col / 7    'mois suivant
 
    Planning.Shapes.AddTextbox(msoTextOrientationHorizontal, l, t, w, h).Select
 
    With Selection
        d = FormatDateTime(DateSerial(Planning.Cells(1, 1), i, 1), vbLongDate) 'recherche texte du mois
        k = 0
        For j = 1 To 2           'après 2 espaces
            k = InStr(k + 1, d, " ")
        Next j
        .Characters.Text = Right(d, Len(d) - k)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
End With
 
Next i
End Sub

et j'ai modifié la position des shapes par rapport au Lundi de chaque semaine :

Code :

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

1
2
3
4
5
6
7
8
9
10
diff = Weekday(DateSerial(Planning.Cells(1, 1), 1, 1), vbMonday) 'distance au lundi!
With Planning
     x = .Range("A1").Width
     h = .Range("A1").Height * 3
     w = x * i / 7
 
     l = x * (j - diff) / 7 + 2 * x 'oubli des cellules vides!! je déduis jusqu'au lundi
 
     t = .Range(r).Top
End With

j'ai mis 2014 en A1 pour faire une feuille qui en changeant l'année initialise une autre sans tout refaire
il faudra éliminer toutes les shapes avant de lancer la macro pour les mois!

le fichier :
TD EXCEL2.xlsm


geogeo70