Le changement du jour ne se fait
Bonjour le forum
J'ai fait divers fichiers grâce à vous mais je me suis rendu compte que il y avait un bug...
Si pour une raison quelconque je modifie le jour par exemple 19 décembre 2019 ça ne me met pas Jeudi ça reste Vendredi.
Peut-on y remédier pou alors?
Merci à vous pour vos retours
Cordialement
Bonjour M12
Oui mais ça ne met pas les Majuscules et c'est le but
Merci à toi
Re M12
Oui j'ai vu ce que tu as modifié dans macro
Mais alors je fait la modif du jour dans quel ordre STP
Colonne A ou F?
Merci à toi
Re,
Colonne A
Tu tapes la date comme ceci par exemple 19/12/19
et le chgt se fera automatiquement
Re
SUPER
un GRAND merci à toi
Bonne journée
Très cordialement
Bonjour M12 ou autre
Le fichier titi fonctionne bien. Mais le fichier toto lui ne veut pas et pourtant je ne vois pas la différence.
Si on veut modifier la date colonne A comme l'a fait M12 ça le met pas en Majuscule (1ère lettre)
Mais ça bug sur les autres double clic des colonnes C D E
Il me semble la ligne ci-dessous il y a incompatibilité de type
Range("F" & Target.Row) = IIf(Target = "", "", CDate(Cells(Target.Row, 1)))Merci à vous
re M12
Ça a l'air fonctionner.
Tu as modifié quoi STP?
Cordialement
Re,
Regarde dans la macro double-click de la feuille
Re M12
SUPER
Autre cas fichier TAUX
Lorsque je tape un chiffre colonne B ça le fait bien mais si je modifie la date colonne A en minuscule (1ère lettre)
Je m'excuse mais je pense qu'après ça devrait aller
Re M12
SUPER
Merci infiniment de t'être "penché" sur mes macros!!!
UN GRAND merci à toi
Peut-être à +!!!
Bon WE
Très cordialement
Re M12 ou un autre
J'ai fait 34 fichiers aucun bug
Un pose problème et jamais vu ça
Lorsque je double clic colonne A ça affiche bien 21 Décembre 2019
Si je modifie par clavier la date 18/12/2019 par exemple ça affiche 30 Décembre 1899
Jamais vu ça encore
Merci à vous
HS: Difficile de mettre un fichier comme pour les autres cas
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row + 1), Target) Is Nothing Then
If Not IsError(Application.Match(CSng(Date), Columns("H"), 0)) Then
Application.EnableEvents = False
MsgBox "Une Consultation existe déjà à cette date"
Target.ClearContents
Target.Offset(, 7).ClearContents
Else
Application.EnableEvents = False
Target.Offset(, 7).Value = Date
Target = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
Application.EnableEvents = True
End If
End If
Application.EnableEvents = True
If Target.Address = "$G$2" Then
Cancel = True
Target.Offset(, 1).EntireColumn.Hidden = Not Target.Offset(, 1).EntireColumn.Hidden
End If
Range("A1").Select
End SubPrivate Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A3:A" & Rows.Count)) Is Nothing Then
Application.EnableEvents = False
Range("H" & Target.Row) = IIf(Target = "", "", CDate(Cells(Target.Row, 1)))
Target = Application.Proper(Format(CDate(Cells(Target.Row, 6)), "dddd dd mmmm yyyy"))
End If
Range("A1").Select
Application.EnableEvents = True
End SubRe,
Je suppose que les onglets ont été rapatriés dans le même classeur
Re M12
Punaise oui mais tu devines tout!!!
Re,
Non, mais au vue des différents classeur en PJ, je me doutais bien que c'étais pour les grouper.
Et le problème vient simplement de la macro qui se trouve dans le ThisWorkbook avec le double-clic.
Lui, il ne sait pas où il doit travailler
re M12
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim N As Integer, Couleur As Integer, Indice As Integer
Dim X As String
Dim Tb, TbCoul
If Sh.Name <> "OPHTALMO_&_ORTHOPTISTE" Then Exit Sub
Application.ScreenUpdating = False
' If Target.Address = "$G$2" Then
' Cancel = True
' Target.Offset(, 1).EntireColumn.Hidden = Not Target.Offset(, 1).EntireColumn.Hidden
If Not Intersect(Range("D3:D142"), Target) Is Nothing Then
Cancel = True
TbCoul = Array(8, 4, 15, 38)
Tb = Array("", "Consultation Classique", "Contrôle Vue", "Urgence", "Contrôle corps flottants") 'Nature Soins
'X = UCase(Trim(Target)) 'Pour mettre en Majuscule
X = (Trim(Target))
If UBound(Filter(Tb, X)) >= 0 Then
Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
Target = Tb(Indice)
Couleur = TbCoul(Indice)
If Couleur = 0 Then
Couleur = Target.Offset(0, -1).Interior.ColorIndex
End If
Target.Interior.ColorIndex = Couleur
Else
Target = ""
End If
ElseIf Not Intersect(Range("C3:C142"), Target) Is Nothing Then
Cancel = True
TbCoul = Array(8, 4, 40, 3)
Tb = Array("", "Dr toto", "tata Orthoptiste", "Olivia") 'Noms Médecins
'X = UCase(Trim(Target)) 'Pour mettre en Majuscule
X = (Trim(Target))
If UBound(Filter(Tb, X)) >= 0 Then
Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
Target = Tb(Indice)
Couleur = TbCoul(Indice)
If Couleur = 0 Then
Couleur = Target.Offset(0, -1).Interior.ColorIndex
End If
Target.Interior.ColorIndex = Couleur
Else
Target = ""
End If
ElseIf Not Intersect(Range("F3:F142"), Target) Is Nothing Then
Cancel = True
TbCoul = Array(8, 4, 26)
Tb = Array("", "Oui", "Non")
'X = UCase(Trim(Target)) 'Pour mettre en Majuscule
X = (Trim(Target))
If UBound(Filter(Tb, X)) >= 0 Then
Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
Target = Tb(Indice)
Couleur = TbCoul(Indice)
If Couleur = 0 Then
Couleur = Target.Offset(0, -1).Interior.ColorIndex
End If
Target.Interior.ColorIndex = Couleur
Else
Target = ""
End If
ElseIf Not Intersect(Range("E3:E142"), Target) Is Nothing Then
Cancel = True
TbCoul = Array(8, 4, 46)
Tb = Array("", "RAS", "Traitement")
'X = UCase(Trim(Target)) 'Pour mettre en Majuscule
X = (Trim(Target))
If UBound(Filter(Tb, X)) >= 0 Then
Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
Target = Tb(Indice)
Couleur = TbCoul(Indice)
If Couleur = 0 Then
Couleur = Target.Offset(0, -1).Interior.ColorIndex
End If
Target.Interior.ColorIndex = Couleur
Else
Target = ""
End If
ElseIf Not Intersect(Range("G3:G142"), Target) Is Nothing Then
Cancel = True
TbCoul = Array(8, 4, 46)
Tb = Array("", "Oui", "Non")
'X = UCase(Trim(Target)) 'Pour mettre en Majuscule
X = (Trim(Target))
If UBound(Filter(Tb, X)) >= 0 Then
Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
Target = Tb(Indice)
Couleur = TbCoul(Indice)
If Couleur = 0 Then
Couleur = Target.Offset(0, -1).Interior.ColorIndex
End If
Target.Interior.ColorIndex = Couleur
Else
Target = ""
End If
End If
Application.ScreenUpdating = True
End SubBonjour M12 ou autre
Voici le fichier épuré
Merci encore à toi pour tout
Cordialement