Discussion :

[Paulineeeeeeee]

Bonjour à tous,

Je commence à peine a faire du VBA donc je rencontre quelques difficultés...
J'aimerais réaliser un planning automatique. C'est à dire avoir un tableau où pour le projet P1, il faudrait saisir les dates des sous projets M1 et M2 et ainsi de suite pour x projets et sur un autre onglet le planning se dessinerait comme ci -dessous:

Je ne vois pas comment je peux automatiser "l'échelle planning" debuter et finir à la bonne semaine, et dessiner une ligne pour représenter la date du jour...
Qqun aurait il déjà conçu un système semblable?

Merci par avance,

Pauline

[Theze]

Bonjour,

Une piste à tester.
Tu poses un rectangle (menu "Insertion"-->"Formes") que tu renomme "Regle" (dans la zone de nom, à gauche de la barre de formule et tu valides avec Entrée) ensuite, tu l'allonge vers le bas puis tu colles ce code dans un module standard et tu l'exécute (F5) ou encore Onglet "Développeur" bouton "Macros" tu surlignes "PosRegle" puis "Exécuter" :

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
 
Sub PosRegle()
 
    Dim Fe As Worksheet
    Dim Regle As Shape
    Dim LgCol As Single
    Dim LgCel As Single
    Dim NBSemMax As Integer
    Dim SemActuelle As Integer
    Dim LaDate As Date
    Dim I As Long
 
    LaDate = Date 'aujourd'hui
'    LaDate = CDate("01/01/2015") 'début d'année
'    LaDate = CDate("31/12/2015") 'fin d'année
 
    Set Fe = ActiveSheet
 
    Set Regle = ActiveSheet.Shapes("Regle")
 
    With WorksheetFunction
 
        NBSemMax = .WeekNum(DateSerial(Year(Date), 12, 31), 2)
        SemActuelle = .WeekNum(LaDate, 2)
 
    End With
 
    Regle.Width = 6.3
 
    LgCel = Fe.Cells(1, 1).Width
 
    'même largeur que la première colonne si nécessaire !
'    LgCol = Fe.Cells(1, 1).ColumnWidth
'
'    For I = 2 To NBSemMax
'
'        Columns(I).ColumnWidth = LgCol
'
'    Next I
 
    Regle.Left = LgCel * SemActuelle - Regle.Width / 2 + (LgCel / 7) * Weekday(LaDate, vbMonday)
 
End Sub

[Paulineeeeeeee]

Je viens de tester mais ça n'a aucun effet... Je ne comprend pas pourquoi il faut créer une shape?!

[Theze]

Bonjour,

Le trait rouge sur ta capture d'écran c'est quoi ?

Le code que je t'ai donné a été fait sur Excel 2007 et je suppose que ta version est ultérieure donc je ne peux pas tester. Normalement, je pense que ça doit fonctionner et pour tester visuellement le déplacement du curseur, tu pose un rectangle sur ta feuille que tu appelles "Regle" et une zone de texte que tu appelles "TxtJour" et que tu positionnes en alignement bas de ta règle ensuite, tu pose un bouton "Formulaire" dans la zone visible de la semaine 42 (celle-ci) et tu lui affecte la macro ci-dessous (PosRegle). J'ai rajouté une variable pour incrémenter les jours de la semaine afin que tu puisses voir le curseur se déplacer et la date correspondante s'inscrire dans la zone de texte.

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
 
Sub PosRegle()
 
    Dim Fe As Worksheet
    Dim Regle As Shape
    Dim Label As Shape
    Dim LgCol As Single
    Dim LgCel As Single
    Dim NBSemMax As Integer
    Dim SemActuelle As Integer
    Dim LaDate As Date
    Dim I As Long
 
    Static Jour As Integer
    Jour = Jour + 1
    If Jour > 7 Then Jour = 1
 
    LaDate = Date + Jour 'aujourd'hui
'    LaDate = CDate("01/01/2015") 'début d'année
'    LaDate = CDate("31/12/2015") 'fin d'année
 
    Set Fe = ActiveSheet
 
    Set Regle = ActiveSheet.Shapes("Regle")
    Set Label = ActiveSheet.Shapes("TxtJour")
 
    With WorksheetFunction
 
        NBSemMax = .WeekNum(DateSerial(Year(Date), 12, 31), 2)
        SemActuelle = .WeekNum(LaDate, 2)
 
    End With
 
    Regle.Width = 6.3
    Label.TextFrame.Characters.Text = Format(Date + Jour, "dddd d mmm yyyy")
 
    LgCel = Fe.Cells(1, 1).Width
 
    'même largeur que la première colonne si nécessaire !
'    LgCol = Fe.Cells(1, 1).ColumnWidth
'
'    For I = 2 To NBSemMax
'
'        Columns(I).ColumnWidth = LgCol
'
'    Next I
 
    Regle.Left = LgCel * SemActuelle - Regle.Width / 2 + (LgCel / 7) * Weekday(LaDate, vbMonday)
    Label.Left = Regle.Left + Regle.Width
 
End Sub

[Paulineeeeeeee]

Ok je vais essayer de l'adapter. Merci