reporter une valeur"V" dans des planning.

Liquido13_bl

XLDnaute Nouveau
Bonjour a tous ,
petit problème qui me rend fouuuuu....

j'ai passé plusieur jours a chercher une solution sur le forum, mais sans fin.

Je pose mon problème:

1- J'aimerai inscrire les dates de vacances dans un tableau (premier jours "le lundi" au dernier jour "le vendredi) les week end de sont pas compter comme des vacances. une semaine de vacances égale à 5 jours.
2- dans les grilles de planning (grille de 28jours) les dates sont inscrite par le code "V" . je joins le fichier.

je suis a dispo pour les questions ....

merci d'avance.

fichier assez gros : 1400MB
Ce lien n'existe plus
ou
Ce lien n'existe plus
 

jeanpierre

Nous a quitté
Repose en paix
Re : reporter une valeur"V" dans des planning.

Bonsoir Liquido13_bl, re le forum,

Sans savoir s'il me sera possible d'y donner suite, j'ai tenté de charger ton fichier.

Les liens donnés sont ceux pour déposer un fichier, enfin, il me semble, ou je n'ai rien compris au fonctionnent de ce site (possible).

Tu n'as pas indiqué le bon lien.

En attendant, bonne soirée.

Jean-Pierre
 

Liquido13_bl

XLDnaute Nouveau
Re : reporter une valeur"V" dans des planning.

je m'explique un peu plus, je voudrai que la lettre "V" soie placée dans les planning automatiquement en pressant sur un bouton ,
exemple : si vacances de Lambelet B. du 01.01.2007 au 07.01.2007 je vais retrouver dans les planning une lettre "V" le lundi au vendredi un "V" et samedi et dimanche "X". sur la ligne Lambelet B. du 1er au 7 janvier .
 

ChTi160

XLDnaute Barbatruc
Re : reporter une valeur"V" dans des planning.

Salut Liquido13_bl
Bonsoir le fil
arff pas evident ta mise en forme tu as des mois ou il y a plus de jours du moi précédent que du mois lui même trop compliqué pour moi
donc je me suis amusé à modifier ton fichier pour l'exemple (car tu as surement des raisons de les mettre sous cette forme mais bon ) pour quoi Juillet 1 et 2 ????

tu entres les congés en feuille vacances, puis tu cliques sur le bouton Lancer le transfert des congés
et ensuite tu regardes le résultat
ce fichier pourra peut être te servir

Le Fichier :http://cjoint.com/?dEtzkT8hkb

Bonne fin de Soirée
 

ChTi160

XLDnaute Barbatruc
Re : reporter une valeur"V" dans des planning.

re
En pièce jointe un fichier où j'ai fais en sorte qu'en sélectionnant un item de la listbox Led on puisse par un Double clic coller la valeur sélectionnée dans les cellules des 2 plages des feuilles Plan Mois
si l'on veux effacer, il suffit de refaire un Double clic sur la cellule à effacer

Le Fichier : http://cjoint.com/?dEvDEk6sGI

Ps J'ai changé le fichier j'avais omis de supprimer dans certaines feuilles les procèdures evenementielles qui si trouvées

Bonne fin de Soirée
 
Dernière édition:
C

Compte Supprimé 979

Guest
Re : reporter une valeur"V" dans des planning.

Bonjour à tous,

ChTi160, je n'ai pas eu le temps de regarder ce que tu avais fait.

En tout cas Liquido, voilà le petit code que je t'ai concocté ;)
A mettre dans un de tes modules

Code:
Sub CreateConges()
  Dim Cel As Object
  Dim NbLig As Integer, DebLig As Integer, DateDeb, DateFin
  Dim MoisDeb As Integer, MoisFin As Integer, TabMois(12)
  Dim LigPers As Integer, NomPers As String, NbPers As Integer
  '
  TabMois(1) = "Janvier": TabMois(2) = "Février": TabMois(3) = "Mars"
  TabMois(4) = "Avril": TabMois(5) = "Mai": TabMois(6) = "Juin"
  TabMois(7) = "Juillet": TabMois(8) = "Août": TabMois(9) = "Septembre"
  TabMois(10) = "Octobre": TabMois(11) = "Novembre": TabMois(12) = "Décembre"
  '
  Sheets("Vacances").Activate
  For NbPers = 4 To 102 Step 7
    ActiveSheet.Range("B" & NbPers).Select
    DebLig = Selection.Row: NomPers = Selection.Value
 
    For NbLig = 0 To 5
      DateDeb = ActiveSheet.Range("D" & DebLig + NbLig).Value
      DateFin = ActiveSheet.Range("F" & DebLig + NbLig).Value
      ' On sort de la boucle si il manque une date de congé
      If DateDeb = "" Or DateFin = "" Then Exit For
      ' Sinon on fait la mise en forme
      MoisDeb = Month(DateDeb): MoisFin = Month(DateFin)
      Do While MoisDeb <= MoisFin
        ' Sélectionne le classeur contenant la valeur du mois des congés
        Sheets("Plan " & TabMois(MoisDeb)).Activate
        ' Trouve la ligne de la personne en cours
        LigPers = LigFind(ActiveSheet.Name, 4, NomPers)
        If LigPers = 0 Then
          MsgBox "Erreur de recherche pour le nom : " & NomPers
          Exit For
        End If
        ' Vérifie si la date correspond aux congés, si oui inscrit "V"
        For Each Cel In ActiveSheet.Range("E19:AF19")
          If Cel.Value >= DateDeb And Cel.Value <= DateFin Then
            Application.EnableEvents = False
            If Weekday(Cel.Value, vbMonday) > 5 Then
              ActiveSheet.Cells(LigPers, Cel.Column).Value = "X"
            Else
              ActiveSheet.Cells(LigPers, Cel.Column).Value = "V"
            End If
            Application.EnableEvents = True
          End If
        Next
        MoisDeb = MoisDeb + 1
      Loop
      Sheets("Vacances").Activate
    Next NbLig
  Next NbPers
End Sub
 
Function LigFind(Feuil As String, NumCol As Integer, Quoi)
  On Error Resume Next
  With Sheets(Feuil).Columns(NumCol)
    ' On recherche une valeur
    LigFind = .Find(What:=Quoi, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, MatchCase:=False).Row
  End With
  On Error GoTo 0
End Function

Reste à voir pour "Plan Juillet 1", "Plan Juillet 2" comment il faut faire !?
Ainsi que pour Décembre de l'année suivante.

A+
 

ChTi160

XLDnaute Barbatruc
Re : reporter une valeur"V" dans des planning.

Re BrunoM45

moi j'ai regardé ton code avec intérêt et voiula ce que j'ai modifié pour qu'il puisse collé les V et le X lorsque la dates de fin est plus grandes que la date qui se trouve dans la feuille Mois
Code:
Sub CreateConges()
  Dim Cel As Object
  Dim NbLig As Integer, DebLig As Integer, DateDeb, DateFin
  Dim MoisDeb As Integer, MoisFin As Integer, TabMois(12)
  Dim LigPers As Integer, NomPers As String, NbPers As Integer
  [COLOR=Blue]Dim OK  As Boolean[/COLOR]
  TabMois(1) = "Janvier": TabMois(2) = "Février": TabMois(3) = "Mars"
  TabMois(4) = "Avril": TabMois(5) = "Mai": TabMois(6) = "Juin"
  TabMois(7) = "Juillet": TabMois(8) = "Août": TabMois(9) = "Septembre"
  TabMois(10) = "Octobre": TabMois(11) = "Novembre": TabMois(12) = "Décembre"
      [COLOR=Blue]OK = False[/COLOR]
  Application.ScreenUpdating = False
  With Sheets("Vacances")
             .Activate
  For NbPers = [COLOR=Blue]8 [/COLOR]To 102 Step 7
             .Range("B" & NbPers).Select
    DebLig = Selection.Row: NomPers = Selection.Value
 
    For NbLig = 0 To 5
      DateDeb = .Range("D" & DebLig + NbLig).Value
      DateFin = .Range("G" & DebLig + NbLig).Value
      ' On sort de la boucle si il manque une date de congé
        If DateDeb > DateFin = "" Then Exit For  'test
      If DateDeb = "" Or DateFin = "" Then Exit For  'test
      ' Sinon on fait la mise en forme
      MoisDeb = Month(DateDeb): MoisFin = Month(DateFin)
      
      Do While MoisDeb <= MoisFin
        
        ' Sélectionne le classeur contenant la valeur du mois des congés
      With Sheets("Plan " & TabMois(MoisDeb))
                           '.Activate
          'test si Date de Fin dans feuille
          'MsgBox .Range("E19").End(xlToRight).Value
             If .Range("E19").End(xlToRight).Value < DateFin Then OK = True
      'End With
        ' Trouve la ligne de la personne en cours
        LigPers = LigFind(.Name, 4, NomPers)
        If LigPers = 0 Then
          MsgBox "Erreur de recherche pour le nom : " & NomPers
          Exit For
        End If
        ' Vérifie si la date correspond aux congés, si oui inscrit "V"
        For Each Cel In .Range("E19:AF19")
          If Cel.Value >= DateDeb And Cel.Value <= DateFin Then
            Application.EnableEvents = False
            If Weekday(Cel.Value, vbMonday) > 5 Then
                         .Cells(LigPers, Cel.Column).Value = ""
                         .Cells(LigPers, Cel.Column).Value = "X"
            Else
                         .Cells(LigPers, Cel.Column).Value = ""
                         .Cells(LigPers, Cel.Column).Value = "V"
            End If
            'Application.EnableEvents = True
          End If
        Next Cel
        End With
         [COLOR=Blue]If [COLOR=Red]OK = True[/COLOR] Then '------------------
        With Sheets("Plan " & TabMois(MoisDeb + 1))
                '.Select
         For Each Cel In .Range("E19:AF19")
            If Cel.Value >= DateDeb And Cel.Value <= DateFin Then
               Application.EnableEvents = False
            If Weekday(Cel.Value, vbMonday) > 5 Then
                     .Cells(LigPers, Cel.Column).Value = ""
                     .Cells(LigPers, Cel.Column).Value = "X"
            Else
                     .Cells(LigPers, Cel.Column).Value = ""
                     .Cells(LigPers, Cel.Column).Value = "V"
            End If
            Application.EnableEvents = True
          End If
          Next
         End With
            OK = False
         End If '------------------------[/COLOR]
         Application.EnableEvents = True
        MoisDeb = MoisDeb + 1
      Loop
      Sheets("Vacances").Activate
    Next NbLig
  Next NbPers
  End With
  Application.ScreenUpdating = True
End Sub
Code:
Function LigFind(Feuil As String, NumCol As Integer, Quoi)
  On Error Resume Next
  With Sheets(Feuil).Columns(NumCol)
    ' On recherche une valeur
    LigFind = .Find(What:=Quoi, LookIn:=xlValues, LookAt:=xlPart, _
                                                SearchOrder:=xlByRows, _
                           SearchDirection:=xlNext, MatchCase:=False).Row
  End With
  On Error GoTo 0
End Function
Merci à toi pour cette procèdure
Bonne fin de Soirée
 

Liquido13_bl

XLDnaute Nouveau
Re : reporter une valeur"V" dans des planning.

Bonjour
merci pour le travail fourni...
Mais le problème c est que je tiens a avoir des plan de 28 jours. 4 semaines.
c'est un peu spécial, mais je dois faire avec ...

désolé.
y a t'il une autre solution ?
 
C

Compte Supprimé 979

Guest
Re : reporter une valeur"V" dans des planning.

Salut Liquido,

Je ne vois pas ou est le problème :confused:

Le code que je t'ai fait, modifié par ChTi160 devrait te convenir, sans toucher à ton fichier d'origine !

Donc ou est le soucis !?
 

Discussions similaires

Réponses
28
Affichages
985

Statistiques des forums

Discussions
312 198
Messages
2 086 132
Membres
103 127
dernier inscrit
willwebdesign