Déduire écriture après Code forçage écriture

Bonjour à tous,

Avec le code ci-après, j'ai voulu obtenir une saisie forcée sous le format hh:mm, avec heure comprise de 00:00 à 23:59, et les ":" comme seuls séparateurs des heures et minutes. Seulement, lorsque "09" est saisie, ce n'est pas traité comme "09:00", ni écrit comme tel dans la cellule excel correspondant au textbox de saisie, ce que j'aimerais justement obtenir. Dans mon code vba, j'ai tenté de définir le format de la cellule :format (time; "hh:mm") sans résultat.

Pourriez-vous me donner une piste ?

Merci.

Xav.

Private Sub CommandButton2_Click()
If DateSaisie.Value <> "" Then          'si la textbox DateSaisie n'est pas vide, alors on continue la procédure
     Else                               'sinon
MsgBox "Veuillez renseigner la date du cours"   'affichage de ce Msgbox
     Exit Sub                           'on sort de la procédure, donc on inscrit rien
     End If                             'fin de la condition
     If Etudiant.Value <> "" Then
     Else
MsgBox "Veuillez renseigner le nom de l'étudiant"
     Exit Sub
     End If
     If Début.Value <> "" Then
     Else
MsgBox "Veuillez renseigner l'heure de début du cours"
     Exit Sub
     End If
     If Fin.Value <> "" Then
     Else
MsgBox "Veuillez renseigner l'heure de fin du cours"
     Exit Sub
     End If
     If Fin > Début Then
     Else
MsgBox "Veuillez vérifier que l'heure de la fin du cours se situe bien après celle du début"
     Exit Sub
     End If
Sheets("BdD").Rows("2:2").Select        'aller à la cellule de laquelle une nouvelle ligne doit-être créée
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove  'création de la nvelle ligne pour écriture
Sheets("BdD").[A2] = Données.Label8.Caption     'écriture du nom et prénom du professeur qui enregistre
Sheets("BdD").[B2] = DateSaisie         'écriture des valeurs saisies dans les cellules correspondantes de la feuille "BdD"
Sheets("BdD").[C2] = Etudiant           'écriture des valeurs saisies dans les cellules correspondantes de la feuille "BdD"
Sheets("BdD").[D2] = Langue             'écriture des valeurs saisies dans les cellules correspondantes de la feuille "BdD"
Sheets("BdD").Range("E2") = Format(Time, "Hh:Nn")
Sheets("BdD").[E2] = Début              'écriture des valeurs saisies dans les cellules correspondantes de la feuille "BdD"
Sheets("BdD").Range("F2") = Format(Time, "h:mm")
Sheets("BdD").[F2] = Fin                'écriture des valeurs saisies dans les cellules correspondantes de la feuille "BdD"
Sheets("BdD").Range("G2").Select        'sélectionner la cellule correspondant au lieu de calcul du nbre d'heures
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"   'calcul du nbre total d'heures, puis écriture dans cellule correspondante
Selection.Font.Bold = False                             'ne pas mettre en gras
Selection.Font.Underline = xlUnderlineStyleNone         'ne pas souligner
    With Selection                                      'appliquer à toute la sélection les caractéristiques suivantes
        .HorizontalAlignment = xlCenter                 'centre horizontal
        .VerticalAlignment = xlBottom                   'position verticale: bas
        .WrapText = False                               'renvoi automatique à la ligne: ne pas appliquer
        .Orientation = 0                                'inclinaison: aucune
        .AddIndent = False                              'aucune indentation
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
ThisWorkbook.Save                       'enregistrer les données saisies dans le formulaire des données
Unload Me                               '1ère étape pour saisie pour nvlles données: vider les textbox du formulaire de données
Données.Label8.Caption = DemandeIDProf.Professeur.Text
Données.Show                            '2ème étape: affichage du formulaire de données vidé
End Sub

Complément : code de forçage de saisie sous hh:mm :

Private Sub Début_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim AKey$
AKey = "[01234567989:]"
If Not ChrW(KeyAscii) Like AKey Then KeyAscii = 0
If Len(Début) = 5 Then KeyAscii = 0: Exit Sub
If Len(Début) = 0 And Not ChrW(KeyAscii) Like "[0-1-2]" Then KeyAscii = 0
If Len(Début) = 1 And Début = 2 And Not ChrW(KeyAscii) Like "[0-1-2-3]" Then KeyAscii = 0
If Len(Début) = 3 And Not ChrW(KeyAscii) Like "[0-1-2-3-4-5]" Then KeyAscii = 0
If Len(Début) = 2 Then
   If ChrW(KeyAscii) <> ":" Then KeyAscii = Asc(":")
End If
End Sub

Bonjour,

Voir en pièce jointe.

A+

32saisieh-v2.xlsm (24.23 Ko)

Salut galopin01,

Je te remercie. Tu as effectivement donné la solution à mon problème.

Merci.

Xav.

galopin01 a écrit :

Bonjour,

Voir en pièce jointe.

A+

Rechercher des sujets similaires à "deduire ecriture code forcage"