XL 2019 Masque de saisie

ADS95 · 2 Novembre 2021

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 · 2 Novembre 2021

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 · 2 Novembre 2021

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

Hasco · 2 Novembre 2021

Re,

Autre question autre fil de discussion comme le suggère la charte du forum et cette fois-ci joignez un fichier !

Charte et règlement des forums

A lire avant de poster sur nos forums.

www.excel-downloads.com

Cordialement

ADS95 · 2 Novembre 2021

Désolé c'est noté.

XL 2019 Masque de saisie

ADS95

XLDnaute Nouveau

Hasco

XLDnaute Barbatruc

ADS95

XLDnaute Nouveau

Hasco

XLDnaute Barbatruc

Charte et règlement des forums

ADS95

XLDnaute Nouveau

Discussions similaires