XL 2019 Masque de saisie

ADS95

XLDnaute Nouveau
Bonjour à tous,

Dans une feuille Excel afin de facilité la rapidité de saisie, j'ai crée un masque de saisie pour les heures sous cette forme 00:00, code ci-dessous.
En saisie, cellule par cellule pas de problème cela fonctionne très bien.
Toutefois, en copier glisser, j'ai une erreur sur "If IsNumeric(Target) And Target > 1 Then"
Après plusieurs recherches, je ne trouve pas de solutions.
Merci d'avance de votre aide.

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Columns("C")) Is Nothing Then
If IsNumeric(Target) And Target > 1 Then
txt = Right("0000" & CStr(Target), 4)
Target = Mid(txt, 1, 2) / 24 + Mid(txt, 3, 2) / 24 / 60
End If
End If
End Sub
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Déjà, lorsqu'on utilise l'évènement change d'une feuille, ne pas créer de rappels en boucle de l'évènement en changeant la valeur de Target.

VB:
'Avant Changement :
Application.EnableEvents = False
Target = Mid(txt, 1, 2) / 24 + Mid(txt, 3, 2) / 24 / 60
' Après changement :
Application.EnableEvents = True

Ensuite ne pas oublier que Target peut être un objet range de plusieurs cellules :
Target.Count ou Target.CountLarge supérieur à 1

Code:
If Target.CountLarge > 1 Then Exit Sub

Cordialement

Utilisez le bouton <> de l'éditeur de post pour publier vos codes.

[Edition]Hello @David Aubert, cette fois, ça marche le bouton 'copier dans le press-papier' Super merci.[/Edition]
 

ADS95

XLDnaute Nouveau
Merci beaucoup Hasco, ça fonctionne très bien.
Si je peux abuser, dans ce même fichier j'ai créer un sommaire dynamique automatique qui fonctionne très bien copy ci-dessous.
Toutefois, quand je souhaite protéger la feuille j'ai des erreurs.
J'ai bien essayé de ne pas protéger les cellules de renvoi "G6" dans le cas présent, mais cela ne fonctionne pas.
Merci encore pour votre aide.

Sub sommaireDynamique()

Dim feuille As Worksheet, bouton As Shape, positionY&
For Each bouton In ActiveSheet.Shapes
If bouton.Name Like "menu_*" Then
bouton.Delete
End If
Next
positionY = 4
For Each feuille In Worksheets
If feuille.Visible Then
Set bouton = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 4, positionY, [a1].Width - 8, 30)
bouton.TextFrame2.TextRange.Characters.Text = feuille.Name
If feuille.Name = ActiveSheet.Name Then
bouton.ShapeStyle = msoShapeStylePreset14
Else
bouton.ShapeStyle = msoShapeStylePreset13
End If

ActiveSheet.Hyperlinks.Add Anchor:=bouton, Address:="", SubAddress:="'" & feuille.Name & "'!G6"
bouton.Name = "menu_" & feuille.Name

positionY = positionY + 30
End If
Next
End Sub
 

Statistiques des forums

Discussions
312 082
Messages
2 085 171
Membres
102 805
dernier inscrit
emes