Planning évolutif | VBA | Excel 2003

[Hellowa]

Bonjour à toutes et a tous,
Je suis actuellement entrain de creer un système de gestion du personnel et de la production pour une petite entreprise, et mon niveau en visualbasic ne me permet pas d'avancer suffisamment.
Vous pourrez voir dans la pièce jointe une partie que j'ai extraite et simplifiée de mon tableau pour mieux comprendre le principe.
J'ai fait le maximum, mais je plante au niveau suivant:
J'aimerai que le chef de production n'aie qu'à actualiser le fichier ( avec une macro) pour qu'il se mette a jour:
En effet, il prévoit le planning d'atelier en général 3 ou quatres semaines a l'avance.
Lorsque l'on actualise le tableau, je souhaiterai que les semaines se décalent afin que la première a apparaitre soit la semaine en cours. La semaine précédente est effacée et la dernière est remplacée par une nouvelle semaine.
J'ai déjà trouvé comment faire pour qu'Excel sache quelle semaine on est, mais c'est pour la suite que j'ai du mal. 🙁
J'espère avoir été clair, les autres informations sont dans la pièce jointe et notamment sur la macro que j'ai commencé de créer.
Merci d'avance de votre aide qui comme j'ai pu le constater est toujours... excellente ( 😀 )
Bonne fin de journée a tous,
Hellowa

 

[JNP]

Re : Planning évolutif | VBA | Excel 2003

Bonjour Hellowa 🙂,
Ton fichier complété et annoté en pièce jointe. Je te l'ai laissé en semaine 16 pour que la macro puisse fonctionner, ainsi qu'une sub pour récupérer les couleurs pour les mois. Le code reste à complèter pour les autres mois qu'avril et mai, soit en rajoutant les Case 1, ColorIndex pour janvier, etc, ou en jouant que sur 2 couleurs avec Case 1, 3, 5, 7, 9, 11 et Case 2, 4, 6, 8, 10, 12 (ou pair et impair en If).
Bonne soirée 😎

 

[PMO2]

Re : Planning évolutif | VBA | Excel 2003

Bonjour,

Essayez avec votre code modifié ci-dessous

Function WeekNumber(Optional ByVal vDate As Variant) As Byte
    If IsMissing(vDate) Then vDate = Date
    WeekNumber = DatePart("ww", vDate, vbMonday, vbFirstFourDays)
End Function
Sub Decalage_semaine()
Dim nbPers&
Dim lastLig&
Dim SEM As Integer
Dim R As Range
Dim lastDate As Date
Dim i&
Dim j&
Dim var
'--- Nombre de personnes ---
lastLig& = [a65536].End(xlUp).Row
nbPers& = lastLig& + 1 - Range("a" & lastLig& & "").End(xlUp).Row
'--- Dernière date ---
lastDate = Range("f" & lastLig& - nbPers&)
'On calcule tout d'abord la semaine en cours
SEM = WeekNumber(Now)
'On vérifie que l'on a bien passé une semaine
If Cells(3, 7) = "Semaine " & SEM Then
  MsgBox (SEM & " est déjà la semaine actuelle")
  '--- Si la semaine en G3 est supérieure à la semaine courante ---
ElseIf CInt(Mid(Cells(3, 7), Len("Semaine ") + 1)) > SEM Then
  MsgBox ("La semaine affichée en G3 est supérieure à la semaine actuelle (" & SEM & ")")
Else
  '--- Déplace la semaine périmée en dernière position ---
  Set R = Range("a2:g" & nbPers& + 2)
  R.Cut Destination:=Range("a" & lastLig& + 2 & ":g" & lastLig& + 2 + nbPers& & "")
  R.Range("g2") = "Semaine " & SEM + 3
  '--- Indique les dates de la nouvelle semaine ---
  For i& = 1 To 5
    Cells(lastLig& + 2, i& + 1) = lastDate + i& + 2
  Next i&
  '--- Efface les anciennes données de la nouvelle semaine ---
  var = R
  For i& = 2 To UBound(var, 1)
    For j& = 2 To UBound(var, 2) - 1
      var(i&, j&) = ""
    Next j&
  Next i&
  R = var
  '--- Supprime les lignes de l'emplacement de la semaine périmée ---
  Set R = Range("a2:g" & nbPers& + 3)
  R.Delete Shift:=xlUp
  [a1].Select
End If
End Sub

Cordialement.

PMO
Patrick Morange

 

[Hellowa]

Re : Planning évolutif | VBA | Excel 2003

Je pense que je vais prendre un peu de vos 2 suggestions! Merci beaucoup messieurs!
J'enverrai en cours de journée le projet en l'état!
Cordialement,
Hellowa

 

[Hellowa]

Re : Planning évolutif | VBA | Excel 2003

J'ai quelques questions.
JNP, pourquoi ta macro s'arrete elle après la semaine 20?
Patrick, que signifie cette ligne?

ElseIf CInt(Mid(Cells(3, 7), Len("Semaine ") + 1)) > SEM Then

Merci tous les deux, je continue de rassembler vos informations!

 

[JNP]

Re : Planning évolutif | VBA | Excel 2003

Re 🙂

JNP, pourquoi ta macro s'arrete elle après la semaine 20?

A partir du moment où elle est basée sur la date du jour, nous sommes en semaine 17 donc elle bâti 17, 18, 19 et 20.
Lundi prochain, elle bâtira 18, 19, 20 et 21 😛. C'était bien ta demande, non 😕?
A + 😎

 

[Hellowa]

Re : Planning évolutif | VBA | Excel 2003

Oui, mais je n'arrive pas a corriger la vérification que la première semaine affichée est bien la bonne!
Actuellement son programme décale systématiquement, sans vérifier... ce qui fait que si on le lance (meme dans l'état actuel) il affiche "semaine 18" en premier, si on le relance une fois encore, il affiche encore semaine 18 et il continue de décaler! (couper coller)

 

[PMO2]

Re : Planning évolutif | VBA | Excel 2003

Bonjour,

  '--- Si la semaine en G3 est supérieure à la semaine courante ---
ElseIf CInt(Mid(Cells(3, 7), Len("Semaine ") + 1)) > SEM Then
  MsgBox ("La semaine affichée en G3 est supérieure à la semaine actuelle (" & SEM & ")")

ElseIf => Sinon si
CInt => Conversion en Integer
Len("Semaine ") => Longueur de la chaîne "Semaine "
Mid => Renvoie une valeur de type Variant (String) contenant un nombre indiqué de caractères extraits d'une chaîne de caractères.
Syntaxe de Mid
Mid(string, start[, length])


Cela donne :

Sinon si la Conversion en Integer de la chaîne (par exemple "Semaine 34" en G3) en partant de longueur de "Semaine " + 1 (ce qui va donner l'extraction chaîne "34") est plus grand que SEM (la semaine actuelle exprimée en Integer) alors
MsgBox ("La semaine affichée en G3 est supérieure à la semaine actuelle (" & SEM & ")")

Cordialement.

PMO
Patrick Morange

 

[Hellowa]

Re : Planning évolutif | VBA | Excel 2003

Damed... Mais ou vont ils chercher tout ça! 😱
Bravo bravo bravo!!!😀

 

[Hellowa]

Re : Planning évolutif | VBA | Excel 2003

Rebonjour,
Patrick, lorsque j'utilise ta formule

If CInt(Mid(Cells(3, 7), Len("Semaine ") + 1)) = SEM Then

J'obtiens un message d'erreur "Error 13, Type Mismatch
Merci d'avance,
Cordialement,
Hellowa

 

[PMO2]

Re : Planning évolutif | VBA | Excel 2003

Bonjour,

If CInt(Mid(Cells(3, 7), Len("Semaine ") + 1)) = SEM Then

J'obtiens un message d'erreur "Error 13, Type Mismatch

Je me réfère à l'exemple que j'ai fait paraître préalablement.
Vous avez dû changer la valeur de la cellule G3.
Supposons qu'en G3 on ait "Sem 17".
Par l'instruction Mid(Cells(3, 7), Len("Semaine ") + 1) on aura une chaîne vide car la longueur de G3 est de 6 caractères alors que Len("Semaine ") donne une longueur de 8 caractères. On essaie de faire une extraction d'une chaîne de 6 caractères à partir de son 9ème caractères (8+1) donc cela plante.

Pour rectifier (en partant de la supposition "Sem 17" en G3) il faut corriger l'instruction comme suit

If CInt(Mid(Cells(3, 7), Len("Sem ") + 1)) = SEM Then

pour, et c'est le but de la manoeuvre, obtenir la chaîne "17" qu'on convertit en Integer par la fonction CInt qui est le bon type de données pour faire la comparaison avec la variable SEM qui a été typée comme Integer.

J'espère être compréhensible.

Cordialement.

PMO
Patrick Morange

 

[Hellowa]

Re : Planning évolutif | VBA | Excel 2003

Bonjour Patrick, bonjour le forum,
Merci pour cette explication on ne peut plus claire,
Mais je pensais cette nuit, plutot que de s'embêter a extraire un chiffre d'une phrase, si on rajoutais ce le bout de phrase à l'autre numéro?
Je m'explique, si au lieu d'enlever "semaine" d'un coté, si on le rajoutais de l'autre?
Quelque chose du genre:
---- If Cells(3, 7) = "Semaine " & SEM then
Non?

 

[JNP]

Re : Planning évolutif | VBA | Excel 2003

Re 🙂,
Pour faire vraiment simple, format de cellule personnalisé "Semaine "00, à ce moment là, il n'y aura plus que le N° de semaine dans la cellule 😉.
Bon courage 😎

 

[PMO2]

Re : Planning évolutif | VBA | Excel 2003

Bonjour,

si au lieu d'enlever "semaine" d'un coté on le rajoutait de l'autre?
Quelque chose du genre:
---- If Cells(3, 7) = "Semaine " & SEM then

C'est ce qui a été fait dans cette partie du code car on compare 2 chaînes

'--- Si G3 = "Semaine " & SEM alors on sort ---
If Cells(3, 7) = "Semaine " & SEM Then
  MsgBox (SEM & " est déjà la semaine actuelle")

En revanche, dans cette partie du code on veut savoir si le nombre de la semaine en G3 > SEM et on compare 2 nombres (cas d'une feuille préparée à l'avance et qui sera utilisée ultérieurement)

  '--- Si la semaine en G3 est supérieure à la semaine courante ---
ElseIf CInt(Mid(Cells(3, 7), Len("Semaine ") + 1)) > SEM Then
  MsgBox ("La semaine affichée en G3 est supérieure à la semaine actuelle (" & SEM & ")")
Else
...

Cordialement.

PMO
Patrick Morange

 

[Hellowa]

Planning terminé

Bonjour
J'ai terminé mon planning, je le met sur le forum, celà pourrai aider quelqu'un un jour, qui sait!
Merci encore a tous pour votre aide tout a long de ce projet.
Bien à vous,
Eloi.