Intégrer des formes dans un planning

Bonjour,

Je débute en VBA et je n'ai pas encore le niveau de réaliser ce que je veux faire.

Pour présenter mon sujet, j'ai un planning qui affiche les 2 prochaines semaines et qui présente les disponibilités de 3 imprimantes. Les semaines se changent dans les cases vertes.

Dans mon classeur, j'ai deux feuilles : une présentant le planning et l'autre les entrées des demandes d'impression.

Quand je reçois une demande d'impression, je rentre les infos dans l'onglet demande (N° de demande, date de fin et heure de fin). Je fais calculer l'heure du début.

Mon but est que lorsqu'une demande est rentrée, grâce à un bouton VBA "mettre à jour", la demande apparait sur le planning à la bonne date, au bon horaire, sur la bonne durée et sur la bonne imprimante. L'intérêt est de prioriser toutes les demandes d'impression et de voir le taux d'occupation des imprimantes.

Je vous joins mon planning simplifié avec des formes souhaitées déjà positionnées manuellement pour exemple. Le texte à l'intérieur serait génial aussi

Si quelqu'un peut me donner une piste sur comment faire ou déjà savoir si c'est faisable facilement, je ne sais même pas par ou commencer... J'ai commencé à colorier les cases dans Excel mais je préférerais insérer une forme variable. Ou peut être qu'il existe une solution bien plus simple ?

Merci à vous pour votre aide.

Salut

tu n a pas indiqué comment tu veux lancer la procédure mais voici une proposition avec un code VBA :

tu peut le lancer par une bouton ou a l aide d un évènement par exemple !

Private Sub Worksheet_Change(ByVal Target As Range)

Set shtDmd = Worksheets("DEMANDES")
Set shtPlg = Worksheets("PLANNING")
drlDmd = shtDmd.Cells(Rows.Count, "A").End(xlUp).Row
For j = 2 To drlDmd
For i = 2 To 300

If shtDmd.Cells(j, "B") = shtPlg.Cells(9, i) And shtDmd.Cells(j, "B") <> "" Then

DHr = Hour(shtDmd.Cells(j, "D"))
FHr = Hour(shtDmd.Cells(j, "C"))
cde = shtDmd.Cells(j, "A")
Nimp = Val(Mid(shtDmd.Cells(j, "F"), 4))
nbr = ((FHr - DHr) / 2) + 1
dc1 = DHr / 2
With shtPlg.Shapes.AddShape(msoShapeRectangle, _
        shtPlg.Cells(10 + Nimp, (i - 1) + dc1).Left, _
        shtPlg.Cells(10 + Nimp, i).Top, _
        shtPlg.Cells(10 + Nimp, i).Width * nbr, _
        shtPlg.Cells(10 + Nimp, i).Height)
    .Name = "Red Square"
    .Fill.ForeColor.RGB = RGB(255, 0, 0)
    .Line.DashStyle = msoLineDashDot
    .TextFrame.Characters.Text = cde
End With
Exit For
End If
Next
Next

End Sub

Merci pour ton retour.

Je n'avais effectivement pas le niveau pour sortir un macro comme ça !!

Je souhaite la lancer avec l'aide d'un bouton sur la page "demandes". Du coup je n'arrive pas à tester ta macro, je n'arrive pas à créer ce bouton qui vient récupérer le lien dans la macro. Faut-il que je créé une autre macro qui appelle ta macro pour ensuite créer mon bouton ?

Salut

essayer de suivre ces instructions :

https://www.excel-pratique.com/fr/vba/introduction

Bonjour,

Désolé pour la réponse tardive, je me suis auto formé sur le VBA et j'ai bien progressé.
Du coup j'ai réussi à lancer ta macro, qui correspond bien à ma demande initiale je te remercie.

En revanche, le problème est que si je change de semaine dans mon planning, la case reste en lieu et place. Elle n'est pas affectée à la date et l'heure du planning mais à la feuille en elle même. Peut-on apporter une correction à ce problème ?

Merci.

Salut

comment tu lance la macro

essayer de l exécuter automatiquement lors d'un événement particulier du classeur, tel que cet événement qui se déclenche à chaque changement de valeur sur une feuille de calcul (tu peux spécifier quel cellule qui déclenche la macro )

voici une correction a essayer :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Set shtDmd = Worksheets("DEMANDES")
Set shtPlg = Worksheets("PLANNING")
drlDmd = shtDmd.Cells(Rows.Count, "A").End(xlUp).Row
For Each frm In shtPlg.Shapes
If frm.Name Like "RedSquare*" Then frm.Delete
Next
For j = 2 To drlDmd
For i = 2 To 300
If shtDmd.Cells(j, "B") = shtPlg.Cells(9, i) And shtDmd.Cells(j, "B") <> "" Then
DHr = Hour(shtDmd.Cells(j, "D"))
FHr = Hour(shtDmd.Cells(j, "C"))
cde = shtDmd.Cells(j, "A")
Nimp = Val(Mid(shtDmd.Cells(j, "F"), 4))
nbr = ((FHr - DHr) / 2) + 1
dc1 = DHr / 2
With shtPlg.Shapes.AddShape(msoShapeRectangle, _
        shtPlg.Cells(10 + Nimp, (i - 1) + dc1).Left, _
        shtPlg.Cells(10 + Nimp, i).Top, _
        shtPlg.Cells(10 + Nimp, i).Width * nbr, _
        shtPlg.Cells(10 + Nimp, i).Height)
    .Name = "RedSquare"
    .Fill.ForeColor.RGB = RGB(255, 0, 0)
    .Line.DashStyle = msoLineDashDot
    .TextFrame.Characters.Text = cde
End With
Exit For
End If
Next
Next

End Sub