Rapport de message :*
 

Re: liste de choix et recherche

Titre du sujet : Re: liste de choix et recherche
par myDearFriend! le 23/06/2010 22:29:48

Bonsoir Nino63, JackyAmiens, le Forum,

Tu trouveras en pièce jointe ton fichier modifié selon ma perception du sujet et qui devrait répondre (je crois) à l'ensemble de tes souhaits.

Tout d'abord, petites explications concernant les points suivants :

Citation :
Nino63 a écrit :
Pour la date de MAJ : (colonne J)
Je pensais utiliser la fonction "MAINTENANT" mais je ne sais pas si c'est la solution au vue des problèmes de réactualisation énoncés un ou deux message au-dessus.
Tu n'étais pas loin de la solution à vrai dire, mais tu fais simplement l'erreur de vouloir insérer dans la cellule la Fonction MAINTENANT() plutôt que sa valeur simple (c'est à dire une constante).

Par nature, une fonction est constamment recalculée par Excel, c'est même le propre des fonctions ! Si tu insères une fonction, il ne faut pas t'étonner de voir la cellule varier dans le temps, c'est son objectif.

Il convient donc d'insérer la VALEUR de la date du jour et non la FONCTION de date du jour.

Et donc, par VBA, au lieu de  :
ActiveCell.Offset(0, 7).Value = "=NOW()"
Il te fallait faire simplement :
ActiveCell.Offset(0, 7).Value = Now
Now étant l'équivalent de la fonction MAINTENANT() dans VBA. Tu remarqueras que je n'insère pas de signe "=" dans la cellule, mais simplement le résultat (valeur) de la fonction Now.

Nb: si on veut se passer de l'heure, alors on utilisera la fonction Date plutôt que Now.

Citation :
Nino63 a écrit :
Pour la date de livraison : (colonne B)
Je choisis la solution d'avoir accès à de petits boutons +/- qui s'afficheraient lorsque l'on clique sur la cellule (et disparait une fois sortie afin de ne pas les voir lorsqu'on imprime le document). De plus, je fait ce choix car en général ce sera pour le lendemain, surlendemain ou au maximum 1 semaine après (plus rarement).
Pour répondre au mieux à ta demande, j'ai joué sur la méthode OnKey de l'objet Application (voir l'aide VBA pour les détails).
Attention toutefois avec l'utilisation de cette méthode OnKey. Il convient de l'utiliser avec prudence et réflexion si tu ne veux pas te retrouver avec des effets inopportuns dans ton application Excel ! Cette méthode est "liée" à l'objet Application, donc à Excel et non au classeur. Ca veut donc dire que si tu ne désactives pas son utilisation avant de quitter le classeur, la méthode reste toujours active pour les classeurs suivants : plantages assurés !!!
On prend donc toujours soin de désactiver ses effets au plus tôt dans le traitement, lorsqu'on en n'a plus besoin. Et on prend aussi la précaution de la désactiver avant la fermeture du classeur en question (voir le module de code de l'objet ThisWorkbook dans l'exemple joint).

Pour orienter l'utilisateur, je me suis contenté d'afficher un message de saisie par l'option de Validation de données des cellules concernées. A toi de voir, si ça vaut vraiment le coup de maintenir ce message pour l'utilisateur ou non.

Je me suis également permis de réviser ton code et l'optimiser un peu (le simplifier également). J'ai aussi pris l'initiative de rassembler tes listes dans un seul et même onglet, côte à côte. Ca permet notamment de faire gagner un peu de poids à ton fichier.

J'ai donc utilisé cette fois le code suivant :

DANS LE MODULE DE CODE DE L'OBJET THISWORKBOOK
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'Désactiver les touches + ou - (retour au mode normal)
    TouchesPM False
End Sub

DANS LE MODULE DE CODE DE LA FEUILLE PLANNING
Option Explicit
' Auteur : myDearFriend!  -  www.mdf-xlpages.com

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub   'ne gère pas la sélection de plage
    If Not Application.Intersect(Target, UsedRange, Range("B13:B65536")) Is Nothing Then
        'Activation touches + et -
        TouchesPM True
    Else
        TouchesPM False
        If Not Application.Intersect(Target, UsedRange, Range("C13:C65536,G13:G65536")) Is Nothing Then
            'On passe un argument à valeur 1 ou 10 selon la liste souhaitée
            AffichListe IIf(Target.Column = 3, 1, 10)
        End If
    End If
End Sub

DANS UN MODULE DE CODE STANDARD (ex: Module1)
Option Explicit
' Auteur : myDearFriend!  -  www.mdf-xlpages.com

Sub AffichListe(NCol As Byte)   'NCol=1 liste SMC /// NCol=10 liste Chargement
Dim CB As CommandBar
Dim M As CommandBarPopup, M1 As CommandBarPopup, Mx As CommandBarButton
Dim TabTemp As Variant
Dim T As String
Dim L As Long
    'On mémorise la "liste SMC" ou la "liste chargement" des données
    With Sheets("Listes")
        L = .Cells(.Rows.Count, NCol).End(xlUp).Row
        TabTemp = .Range(.Cells(2, NCol), .Cells(L, NCol + 3)).Value
    End With
    'On crée une barre de menu temporaire
    On Error Resume Next
    Application.CommandBars("MenuD").Delete
    On Error GoTo 0
    Set CB = Application.CommandBars.Add("MenuD", msoBarPopup, , True)
    For L = 1 To UBound(TabTemp, 1)
        '1er niveau du menu (niveau principal)
        Set M = ElmtMenu(TabTemp(L, 1), CB, True)
        '
        If NCol = 1 Then    'Selon la liste cible
            '2ème niveau du menu
            Set M1 = ElmtMenu(TabTemp(L, 2), M, True)
            'Dernier niveau du menu
            Set Mx = ElmtMenu(TabTemp(L, 3), M1, False)
        Else
            'Dernier niveau du menu
            Set Mx = ElmtMenu(TabTemp(L, 2), M, False)
        End If
        'Action
        T = "'Maj """ & M.Caption & "|"
        If NCol = 1 Then
            T = T & M1.Caption & "|"
        End If
        Mx.OnAction = T & Mx.Caption & """'"
    Next L
    'Affiche le menu
    With Application.CommandBars("MenuD")
        If .Controls.Count > 0 Then .ShowPopup
        .Delete
    End With
End Sub

Private Function ElmtMenu(ByVal T$, MenuParent As Object, Pop As Boolean) As Object
Dim M As CommandBarControl
    On Error Resume Next
    Set M = MenuParent.Controls(T)
    On Error GoTo 0
    If M Is Nothing Then
        Set M = MenuParent.Controls.Add(IIf(Pop, msoControlPopup, msoControlButton), , , , True)
        M.Caption = T
    End If
    Set ElmtMenu = M
End Function

Sub Maj(ByVal T As String)
Dim TabTemp() As String
Dim C As Byte
    'MAJ cellules
    TabTemp = Split(T, "|")
    For C = 0 To UBound(TabTemp)
        ActiveCell.Offset(0, C).Value = TabTemp(C)
    Next C
    'Date de MAJ
    Cells(ActiveCell.Row, 10).Value = Now
End Sub

Sub TouchesPM(A As Boolean)
    With Application
        If A Then
            .onkey "{+}", "'DatPM 1'"
            .onkey "{-}", "'DatPM -1'"
        Else
            .onkey "{+}"
            .onkey "{-}"
        End If
    End With
End Sub

Sub DatPM(SgnPM As Integer)
Dim D As Date
    If IsDate(ActiveCell.Value) Then
        ActiveCell.Value = ActiveCell.Value + SgnPM
    End If
End Sub

En espérant que ça te soit utile...

Cordialement,