Probleme text to column derniere ligne

Bonjour,

Nouveau problème rencontré.J'ai créé un formulaire qui me permet de remplir les colonnes d'un tableau par de biai de textbox.Dans 3 d'entre elles, je rentre soit une date, soit une heure.Lorsque je rempli mon formulaire et que je valide les données,tout s'incrémente dans le tableau comme il faut cependant je dois passer par une étape de "text to columns" pour convertir ces données texte en date ou en heure.Dans VBA j'ai donc demandé: "quand l'userform est activé alors un processus de "text to columns" doit être lancé."

Le problème est qu'une que le code a été éxécuté, je me rend compte que la dernière ligne créée n'a pas fait l'objet d'un text to columns.

Mon code est le suivant:

Private Sub VALIDER_Click()
Dim ctrl As Control
Dim r As Integer
Dim derligne As Integer

TextBox2.Value = Format(Date, "DD/MM/YYYY")
TextBox5.Value = Format(TextBox5.Value, "DD/MM/YYYY")

With Worksheets("CELLULE QUALITE")

derligne = .Range("C1048576").End(xlUp).Row + 1

For Each ctrl In UserForm1.Controls

r = Val(ctrl.Tag)

If r > 0 Then Sheet1.Cells(derligne, r) = ctrl

Next

End With

TextBox1 = ""

End

End Sub
Private Sub UserForm_Activate()

    Range("Table1[DATE PRISE R1]").Select
    Selection.TextToColumns Destination:=Range("E10"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Range("Table1[DATE R1]").Select
    Selection.TextToColumns Destination:=Range("F10"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Range("Table1[HEURE R1]").Select
    Selection.TextToColumns Destination:=Range("G10"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Range("A1").Select

End Sub

Une idée peut être?

Merci!

Bonjour

Relien33 a écrit :

Une idée peut être?

A 1ère vue je me demande pourquoi ce "TextToColumns"

Ensuite je me dis qu'avec le fichier je comprendrais (peut-être)

Mais damned .... pas de fichier

Re,

J'ai joint un fichier comprenant tout ce qu'il faut.

En entrant des valeur via le formulaire "nouveau rendez vous" vous verrez que les dates et les heures necessitent une validation de donnée pour êtres considérées en tant que telles.

Exemple:Je viens de rentrer une nouvelle ligne via le formulaire et vous voyez que dans la ligne de monsieur dupont, la valeur de la colonne "indice soir" est OUI alors qu'elle devrait être NON (cf formule de la cellule en question)

Bonjour

Désole mais je ne sais pas si je vais t'aider

Déjà il commence à me causer british

This shape represents a table slicer. Table slicers can be used in at least Excel 2013.

If the shape was modified in an earlier version of Excel, or if the workbook was saved in Excel 2010 or earlier, the slicer cannot be used.

Exemple Range("Table1[DATE PRISE R1]") XL 2003 n'aime pas, je pense que c'est pour sélectionner directement la colonne dans la liste

J'ai essayer une autre manière

Mais attention les données existantes ne sont pas modifiées

J'ai supprimer la macro UserForm_Activate ( il faut l'appliquer une fois et puis basta )

J'ai modifier la macro VALIDER_Click : Tu as Indice soir conforme (enfin je le crois)

Private Sub VALIDER_Click()
Dim ctrl As Control
Dim r As Integer
Dim derligne As Long

  TextBox2.Value = Format(Date, "DD/MM/YYYY")
  TextBox5.Value = Format(TextBox5.Value, "DD/MM/YYYY")

  With Worksheets("CELLULE QUALITE (2)")
    derligne = .Range("C" & Rows.Count).End(xlUp).Row + 1
    For Each ctrl In UserForm1.Controls
      r = Val(ctrl.Tag)
      If r > 0 Then
        If r > 4 And r < 8 Then
          .Cells(derligne, r) = CDate(ctrl)
          If r = 7 Then .Cells(derligne, r).NumberFormat = "h:mm;@"
        Else
          .Cells(derligne, r) = ctrl
        End If
      End If
    Next
  End With
  TextBox1 = ""
  End
End Sub

Re,

J'ai trouvé mon dieu ca y est c'est PARFAIT!!!!!

Je vais décrypter la chose pour apprendre un peu plus

Merci beaucoup et bonne soirée!