XL 2013 Planning alerte chevauchement MFC

[incubus20851]

Bonjour à toutes et à tous,

En pièce jointe j'ai un planning qui sert à renseigner sur l'utilisation d'un véhicule en Pool.

1ère question :
Mon soucis c'est que j'aimerais que la case passe en rouge quand un autre utilisateur utilise déjà le véhicule ce jour là sur cette plage horaire. La difficulté c'est de trouver une formule qui regarde si il y a un chevauchement de période sur le jour entre celle déjà enregistré et celle que l'on veut inscrire.. Vous avez une solution ?

2ème question pour les Excelliums :
Je souhaiterais que l'utilisateur qui ouvre le fichier dont le Nom d'utilisateur se retrouve en cellule AQ1, ne puisse modifier que les lignes où en colonne AQ y'a son nom d'utilisateur. Sous entendu que l'utilisateur ne puisse pas modifier ou supprimer une ou des lignes des autres utilisateurs qui ont donc un nom d'utilisteur différent du sien

Merci d'avance pour vos réponses
Vincent

 

[job75]

Bonsoir Vincent, alias incubus20851,

2 remarques d'abord :

- les formules dans la plage K10:AO32 étaient inutiles, il suffit de faire une MFC avec formule

- la 2ème question nécessite du VBA donc on contrôlera les dates/heures par VBA.

Voici le code, à placer dans le ThisWorkbook du fichier joint (Alt+F11) :

Private Sub Workbook_Open()
Dim nom$
nom = Environ("UserName")
With Feuil1 'CodeName de la feuille, à adapter
  If Application.CountIf(.Range("AQ10:AQ" & .Rows.Count), nom) Then
    Application.ScreenUpdating = False
    .Unprotect "toto" 'mot de passe à adapter
    .Range("AQ10:AQ" & .Rows.Count).Replace nom, 0, xlWhole
    Intersect(.[A:J], .Range("AQ10:AQ" & .Rows.Count).SpecialCells(xlCellTypeConstants, 1).EntireRow).Locked = False 'déverrouille les cellules autorisées
    .Range("AQ10:AQ" & Rows.Count).Replace 0, nom
  End If
  .Protect "toto", UserInterfaceOnly:=True 'mot de passe à adapter
End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Feuil1 'CodeName de la feuille, à adapter
  .Protect "toto", UserInterfaceOnly:=True 'mot de passe à adapter
  .Cells.Locked = True 'verrouille toutes les cellules
End With
Save 'enregistrement
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim r As Range, t, deb#, fin#, nom$, i&
With Feuil1 'CodeName de la feuille, à adapter
  If Sh.Name = .Name Then
    If Not Intersect(Target, .[G:J]) Is Nothing Then
      Set r = Intersect(Target.EntireRow, .[G:G])
      t = .Range("G10", .Range("AQ" & .Rows.Count).End(xlUp)) 'à adapter éventuellement
      Application.EnableEvents = False 'désactive les évènements
      On Error Resume Next 'sécurité
      For Each r In r 'si entrées/effacements multiples
        If IsError(CDate(r + r(1, 2))) Or IsError(CDate(r(1, 3) + r(1, 4))) Then Application.Undo: GoTo 1
        deb = r + r(1, 2): fin = r(1, 3) + r(1, 4): nom = r(1, 37)
        For i = 1 To UBound(t)
          If t(i, 37) <> "" Then If t(i, 37) <> nom Then _
            If deb > 0 And deb >= t(i, 1) + t(i, 2) And deb <= t(i, 3) + t(i, 4) Or _
              fin > 0 And fin >= t(i, 1) + t(i, 2) And fin <= t(i, 3) + t(i, 4) _
                Then MsgBox "Véhicule occupé sur cette période !", 48: r.Resize(, 4) = "": Exit For
      Next i, r
1    Application.EnableEvents = True 'réactive les évènements
    End If
  End If
End With
End Sub

Le nom de l'utilisateur (nom de l'ordinateur) doit se trouver en colonne AQ uniquement sur la ou les lignes qui lui sont autorisées.

Si vous ne connaissez pas le nom de votre ordinateur exécutez cette macro :

Sub a()
MsgBox Environ("UserName")
End Sub

Enfin si vous ne voulez pas que l'utilisateur puisse voir le mot de passe "toto" protégez le VBAProject.

Bonne nuit.

 

[job75]

Bonjour Vincent, le forum,

Voici une solution bien plus complète dans ce fichier (2).

Il y a d'abord 2 MFC différentes, sur les colonnes A:F et G:AK, pour appliquer les couleurs et les bordures.

Ensuite le nom de l'ordinateur, quel qu'il soit, est entré automatiquement en colonne AM :

Private Sub Workbook_Open()
Dim nom$
nom = Environ("UserName")
With Feuil1 'CodeName de la feuille, à adapter
  .Visible = xlSheetVisible 'au cas où...
  .Activate
  .Range("A9:A" & .Rows.Count).Find("", , xlValues).Select 'sélection de la 1ère cellule vide pour le cadrage
  .Unprotect "toto" 'mot de passe à adapter
  .Range("AM" & ActiveCell.Row) = nom 'entre le nom de l'ordi en colonne AM
  .Range("AM10:AM" & .Rows.Count).Replace nom, 0, xlWhole
  Intersect(.[A:F], .Range("AM10:AM" & .Rows.Count).SpecialCells(xlCellTypeConstants, 1).EntireRow).Locked = False 'déverrouille les cellules autorisées
  .Range("AM10:AM" & Rows.Count).Replace 0, nom
  .Protect "toto", UserInterfaceOnly:=True 'mot de passe à adapter
End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim n&
With Feuil1 'CodeName de la feuille, à adapter
  .Protect "toto", UserInterfaceOnly:=True 'mot de passe à adapter
  .Cells.Locked = True 'verrouille toutes les cellules
  With .Range("A9:A" & .Range("AM" & .Rows.Count).End(xlUp).Row)
    .Resize(, 39).Sort .Cells(1), xlAscending, Header:=xlYes 'tri alphabétique sur la colonne A
    n = Application.CountBlank(.Cells) 'nombre de cellules vides en colonne A
    If n Then .Find("", , xlValues).Resize(n, 39).ClearContents 'les lignes sans nom en colonne A sont effacées
  End With
End With
Save 'enregistrement
End Sub

Pour permettre le tri du tableau il n'y a plus de cellules fusionnées en colonne B.

A+

 

[job75]

Bonjour Vincent, le forum,

2 améliorations importantes dans ce fichier (3), c'est maintenant aux petits oignons :

- le tableau en A:F peut être trié ou filtré car toutes les cellules sont déverrouillées (mais contrôlées)

- on peut toujours continuer à entrer/effacer des données dans les cellules jaunes.

A+

 

[incubus20851]

Bonjour Job75,

Désolé pour le temps de réponse,

Merci beaucoup pour cette solution, effectivement c'est au top !!!!

Tout simplement Excellllent !!!
Bonne journée

 

[job75]

Re,

Non ce n'était pas au top, les contrôles des entrées et du recouvrement des périodes étaient insuffisants.

Je viens de les modifier dans les fichiers (2) et (3).

Noter que je ne contrôle pas l'année, l'utilisateur doit quand même vérifier un peu ce qu'il fait.

A+

 

[job75]

Re,

Encore une chose, vous avez peut-être remarqué que j'ai rendu impossible le copier-coller.

Mais il faut aussi rendre impossible le glisser-déplacer dès l'ouverture :

Application.CellDragAndDrop = False 'glisser-déplacer impossible

Il est rétabli à la fermeture.

Cela dit l'utilisateur peut le rétablir entre-temps dans les options du fichier mais ce serait du sabotage.

Les fichiers (2) et (3) ont été de nouveau modifiés.

A+

 

[job75]

Re,

Dans le fichier (3) pas de problème avec le filtrage par contre le tri ne fonctionne pas bien du tout :

- si l'on utilise la commande du ruban c'est la pagaille

- les noms en colonne AM ne suivent pas.

Je l'ai donc supprimé dans ce fichier (4), c'est lui qu'il faut utiliser.

A+

 

[job75]

Bonjour Vincent, le forum,

Le tri est quand même une chose utile alors voyez ce fichier (5) et le double-clic dans la plage A9:F9.

Bonne journée.

 

[job75]

Re,

Vous aurez sûrement vu qu'on peut se passer du planning car il n'est pas d'une grande utilité.

Le fichier joint peut être utilisé pour un nombre quelconque d'années.

A+

 

[incubus20851]

Bonjour Job75,

C'est sympa mais pour mon besoin j'vais plûtôt garder le planning, par contre mon fichier se présente de cette facon (en PJ)

sur l'onglet C3, je n'arrive pas à modifier les lignes existantes...

Merci beaucoup pour votre aide !

 

[job75]

Bonjour Vincent,

Bah j'aurais dû y penser que vous alliez mettre plusieurs tableaux sur la même feuille !

En l'état aucun des codes que j'ai donnés ne peut fonctionner, il faut tout reprendre à zéro.

Je verrai cela si j'ai le temps car maintenant c'est la période des fêtes.

A+

 

[incubus20851]

Non c'est ma faute j'aurais dû le préciser dès le début... désolé !

Pas de soucis, on reprend apres les fêtes si vous voulez !

Bonne fêtes à vous et vos proches !
Merci
Vincent

 

[job75]

Bonsoir Vincent, le forum,

Le temps qui m'était disponible je vous l'ai consacré, voyez le fichier joint.

Les codes sont nettement différents, j'espère que je n'ai rien oublié, je vous laisse tester.

Dans chaque tableau il suffit d'entrer son nom sur la 1ère ligne vide.

Nota : pour masquer les quadrillages surtout ne pas colorer les cellules en blanc, utiliser la mise en page.

Edit : j'ai revu le contrôle du recouvrement, les "=" n'étaient pas utilisés correctement.

Joyeux Noël à tous.

 

[job75]

Re,

Une précision utile si vous voulez modifier les données d'une feuille :

- bien sûr ôter la protection de la feuille, mot de passe toto

- dans VBA menu Exécution => Mode Création pour désactiver toutes les macros.

- fermer le fichier en enregistrant les modifications.

A+