code pour remplacer une petite liste de validation (proposition!!)!

[pascal21]

bonjour le forum
pour une fois, je n'arrive pas en temps que demandeur
je viens de découvrir, pas hasard, un code qui pourrais permettre de remplacer une petite liste de validation 3 ou 4 items
un simple clic droit dans une cellule permet de faire alterner 1, 2, ou plus valeurs indiquées à l'avance dans le code

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Not Intersect([Champencours], Target) Is Nothing Then
If IsEmpty(ActiveCell.Value) Then

ActiveCell.Value = "en cours"
ElseIf ActiveCell.Value = "en cours" Then

ActiveCell.Value = ""
End If
End If

If Not Intersect([Champencours], Target) Is Nothing Then
If IsEmpty(ActiveCell.Value) Then

ActiveCell.Value = "fait"
ElseIf ActiveCell.Value = "fait" Then

ActiveCell.Value = ""
End If
End If


Cancel = True
End Sub

je ne prétends pas avoir inventé quoi que ce soit
mais je n'avais pas encore vu ce genre manipulation sur le forum
je ne résiste donc pas au plaisir de le faire partager
même si pour la plus part d'entre vous , ça ne sera pas un "scoop"

 

[job75]

Re : code pour remplacer une petite liste de validation (proposition!!)!

Bonjour Pascal,

Je ne sais où tu as trouvé ce code, mais par charité pour l'auteur, je ne ferai pas de commentaire.

A+

 

[MJ13]

Re : code pour remplacer une petite liste de validation (proposition!!)!

Bonjour Pascal, Job

Pascal: Intéressant comme fichier.

Par contre, je prèfère le cancel=true au début.

Je ne sais où tu as trouvé ce code, mais par charité pour l'auteur, je ne ferai pas de commentaire.

Job: Pas trop compris, comme dirait Gruick, si c'est du lard ou du cochon .

 

[job75]

Re : code pour remplacer une petite liste de validation (proposition!!)!

Salut MJ13, mes meilleurs voeux,

C'était du cochon.

Un code sans prétention mais qui permet d'avoir autant d'items que l'on veut sans compliquer la macro :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Intersect([Champencours], ActiveCell) Is Nothing Then Exit Sub
Dim tablo(), pos
Cancel = True
tablo = Array("", "TOTO1", "TOTO2", "TOTO3", "TOTO4", "TOTO5")
pos = Application.Match(ActiveCell, tablo, 0)
If IsEmpty(ActiveCell) Then pos = 1
If IsError(pos) Then Exit Sub
ActiveCell = tablo(pos Mod (UBound(tablo) + 1))
End Sub

A+

 

[pascal21]

Re : code pour remplacer une petite liste de validation (proposition!!)!

bonjour Pascal,

Je ne sais où tu as trouvé ce code, mais par charité pour l'auteur, je ne ferai pas de commentaire.

bonjour à tous
en fait j'utilise ce code la première partie) pour inscrire et effacer une valeur dans une cellule au clic droit
en recopiant ce code pour avoir une autre zone, je me suis trompé et ça a donné ce résultat
après vous en faites ce que vous voulez
moi je sais que ça va me servir

 

[Lii]

Re : code pour remplacer une petite liste de validation (proposition!!)!

Bon jour,

(pas fana pour le clic droit, surtout si rapide) un autre exemple :

Dim vI(11) As Byte, vL As Byte
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  On Error Resume Next
  If Not Intersect(Target, [A1:A11]) Is Nothing Then
      vL = Target.Row
      Target = Array("oui", "non", "?", "")(vI(vL))
      vI(vL) = vI(vL) + 1
      If vI(vL) > 3 Then vI(vL) = 0
  End If
  Cancel = True
End Sub

 

[MJ13]

Re : code pour remplacer une petite liste de validation (proposition!!)!

Re Meilleurs voeux de même (quoique je l'ai déjà souhaité)

Pascal: C'est le genre de code que j'aime bien car comme cela, on a pas besoin de le pondre (l'oeuf ou la poule) .

Job: En le lisant, je l'avais interprêté plutôt comme du lard . Par contre je me doutais que tu nous préparais un petit code. Merci, c'est bien quand on maîtrise.

En plus, c'est marrant, hier, en refaisant mon planning qui était vieux de 10 ans (j'ai tout viré pour tout refaire à neuf avec du VBA, mais je n'ai pas pu m'empêcher de mettre des macros XL4), j'au utilisé l'array avec l'aide F1, que j'utilise très peu pour colorié les jours fériés.

Et j'ai fait un petit planning que voici.

Bonne soirée .

 

[pascal21]

Re : code pour remplacer une petite liste de validation (proposition!!)!

re

Pascal: C'est le genre de code que j'aime bien car comme cela, on a pas besoin de le pondre (l'oeuf ou la poule)

.
????????????????

 

[MJ13]

Re : code pour remplacer une petite liste de validation (proposition!!)!

Re , Bonjour Lii

Lii: Ah , je n'avais pas vu ton post du 05/01.

Merci. C'est une autre façon de faire .

Code:
Pascal: C'est le genre de code que j'aime bien car comme cela, on a pas besoin de le pondre (l'oeuf ou la poule)
.
????????????????

Pascal: Alors, tu ne comprends, ni les compliments , ni l'humour . Cette dernière, il vaut mieux l'avoir aujourd'hui.

Sinon, j'ai revu la macro pour colorié les jours fériés d'un planning (c'est facilement adaptable).

La voici:

Sub Colorie_Fériés()
'MJ
On Error Resume Next
'Stop
Dim JAT As Variant
jours_férié_fixes = Array("01/01", "01/05", "08/05", "14/07", "15/08", "01/11", "11/11", "25/12")
'Trouve les jours fériés fixes
For n = 0 To 7
JAT = jours_férié_fixes(n)
Columns("B:B").Select
    Selection.Find(What:=JAT, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        Colorie_Jour
Next
'Jour fériés mobiles issu de:
'http://xcell05.free.fr/pages/form/dateheure.htm
'- Lundi de Pâques :
'=FRANC((JOUR(MINUTE(A/38)/2+55)&"/4/"&A)/7;)*7-5
'- Jeudi de l'Ascension :
'=FRANC((JOUR(MINUTE(A/38)/2+55)&"/4/"&A)/7;)*7+33
'- Lundi de Pentecôte :
'=FRANC((JOUR(MINUTE(A/38)/2+55)&"/4/"&A)/7;)*7+44
'Ajoute feuille pour calculer le lundi de pâques
Sheets.Add
'Stop
'Entrez l'année à prende en compte (ici l'année en cours,
'modifier now si une autre année ou faire référence à une cellule de la feuille)
ActiveCell = Year(Now)
ActiveCell.Offset(0, 1) = "=DOLLAR((DAY(MINUTE(RC[-1]/38)/2+55)&""/4/""&RC[-1])/7,)*7-5"
Lundi_Paques = Format(CDate(Range("B1")), "dd/mm")
Jeudi_Ascension = Format(CDate(Range("B1")) + 38, "dd/mm")
Lundi_Pentecote = Format(CDate(Range("B1")) + 49, "dd/mm")
Application.DisplayAlerts = False
'Supprime feuille ajoutée
ActiveSheet.Delete
Application.DisplayAlerts = True
'Stop
'Trouve les jours fériés mobiles
For n = 0 To 2
Jours_Fériés_Mobiles = Array(Lundi_Paques, Jeudi_Ascension, Lundi_Pentecote)
JAT = Jours_Fériés_Mobiles(n)
Columns("B:B").Select
    Selection.Find(What:=JAT, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        Colorie_Jour
Next
Range("A2").Select
End Sub
Sub Colorie_Jour()
'MJ: Utiliser l'enregistreur de macros en mode relatif pour colorier la zone à prendre en compte et sa couleur
ActiveCell.Range("A1:C2").Select
       With Selection.Interior
        .ColorIndex = 35
        .Pattern = xlSolid
       End With
End Sub

Si d'autres ont des petites macros sympas pour nous aider au quotidien en ce début d'année, ils seront les bienvenus sur cete discussion .

Bonne journée .

 

[pascal21]

Re : code pour remplacer une petite liste de validation (proposition!!)!

bonjour à tous
si mj13 ce n'est pas parce que je n'ai pas compris une blague que je n'ai pas d'humour
celle là m'a échappée voilà tout
pour colorier les jours fériés je préfère de loin la méthode de la liste nommée et en MFC
très simple à mettre en place
bonne journée
pour moi en ce moment c'est sous la neige