Dates inversées

Bruce68

XLDnaute Impliqué
Private Sub CommandButton3_Click()
'Private Sub cmdTransferer_Click()
Dim Lig As Integer
Dim Col As Integer
Bonsoir à tous
Pourquoi avec cette macro certaines dates (derniere colonne) sont inversées.
Les dates sont mises dans la base à l'aide d'un calendrier (DTPicker) en extraction dans ListView elles sont toujours correctes.
Est il possible de faire le transfert dans leur etat initial ?
Je vous remercie de votre aide.

With Worksheets("Transfert")
.Range("A3:J" & .Range("A" & Cells.Rows.Count).End(xlUp).Row + 1).ClearContents

For Lig = 1 To ListView1.ListItems.Count
.Range("A" & Lig + 2).Value = ListView1.ListItems(Lig).Text
' Détail des autres colonnes
For Col = 1 To 9
.Cells(Lig + 2, Col + 1).Value = ListView1.ListItems(Lig).ListSubItems(Col).Text
Next Col
Next Lig
End With
Unload Me
Sheets("Transfert").Select
End Sub
 

cbea

XLDnaute Impliqué
Re : Dates inversées

Bonjour Bruce68,

Avant l'enregistrement de la date dans une cellule de la feuille, il faut convertir la date. Si cela n'est pas fait, Excel permute le mois et le jour au format "mm/dd/yyyy" lorsque la date le permet.

Voici une partie du code à modifier :
Code:
    For Lig = 1 To ListView1.ListItems.Count
        .Range("A" & Lig + 2).Value = ListView1.ListItems(Lig).Text
        ' Détail des autres colonnes
        For Col = 1 To [COLOR="Red"]8[/COLOR]
            .Cells(Lig + 2, Col + 1).Value = ListView1.ListItems(Lig).ListSubItems(Col).Text
        Next Col
        [COLOR="Red"]If IsDate(ListView1.ListItems(Lig).ListSubItems(9).Text) Then
            .Cells(Lig + 2, Col + 1).Value = CDate(ListView1.ListItems(Lig).ListSubItems(9).Text)
        End If[/COLOR]
    Next Lig
 

Bruce68

XLDnaute Impliqué
Re : Dates inversées

Bonsoir à tous

Merci cbea pour le bout de macro à rajouter , plus aucun probleme .

Une derniere chose, comment dans une ListView mettre certaines colonnes au Format
0.00 €

En vous remerciant pour l'aide Apportée.
 

cbea

XLDnaute Impliqué
Re : Dates inversées

Bonsoir Bruce68,

En mettant par exemple :
Code:
ListView1.ListItems(LigList).ListSubItems.Add , , [COLOR="Red"]Format([/COLOR]Range("B" & Lig).Value[COLOR="red"], "0.00 €")[/COLOR]
 

Bruce68

XLDnaute Impliqué
Re : Dates inversées

Bonsoir à tous
Encore besoin de votre aide
J'ai rajouté un tri sur 2 colonnes ( Colonne A pour les Noms et colonne J; derniere colonne pour les dates et là j'ai une erreur :

Erreur d'éxécution 1004
La méthode Select de la classe range a échoué.

Je vous remercie de votre aide.

Private Sub CommandButton3_Click()
Dim Lig As Integer
Dim Col As Integer

With Worksheets("Transfert")
.Range("A4:J" & .Range("A" & Cells.Rows.Count).End(xlUp).Row + 1).ClearContents

For Lig = 1 To ListView1.ListItems.Count
.Range("A" & Lig + 3).Value = ListView1.ListItems(Lig).Text
' Détail des autres colonnes
For Col = 1 To 8
.Cells(Lig + 3, Col + 1).Value = ListView1.ListItems(Lig).ListSubItems(Col).Text
Next Col
If IsDate(ListView1.ListItems(Lig).ListSubItems(9).Text) Then
.Cells(Lig + 3, Col + 1).Value = CDate(ListView1.ListItems(Lig).ListSubItems(9).Text)
End If
Next Lig
.Range("A3:J" & .Range("A" & Cells.Rows.Count).End(xlUp).Row).Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("J4") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
End With
Unload Me
Sheets("Transfert").Select
End Sub
 

cbea

XLDnaute Impliqué
Re : Dates inversées

Bonsoir Bruce68,

Voici une solution :

Code:
Private Sub CommandButton3_Click()
    Dim Lig As Long
    Dim Col As Long
    [COLOR="red"]Dim derLig As Long[/COLOR]

    With Worksheets("Transfert")
        .Range("A4:J" & .Range("A" & Cells.Rows.Count).End(xlUp).Row + 1).ClearContents
        
        For Lig = 1 To ListView1.ListItems.Count
            .Range("A" & Lig + 3).Value = ListView1.ListItems(Lig).Text
            ' Détail des autres colonnes
            For Col = 1 To 8
                .Cells(Lig + 3, Col + 1).Value = ListView1.ListItems(Lig).ListSubItems(Col).Text
            Next Col
            If IsDate(ListView1.ListItems(Lig).ListSubItems(9).Text) Then
                .Cells(Lig + 3, Col + 1).Value = CDate(ListView1.ListItems(Lig).ListSubItems(9).Text)
            End If
        Next Lig
        
        [COLOR="red"]derLig = .Range("A" & Cells.Rows.Count).End(xlUp).Row
        If derLig > 3 Then[/COLOR]
            .Range("A3:J" & derLig).Sort _
                Key1:=.Range("A4"), Order1:=xlAscending, _
                Key2:=.Range("J4"), Order2:=xlAscending, _
                Header:=xlGuess, OrderCustom:=1, _
                MatchCase:=False, Orientation:=xlTopToBottom, _
                DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
        [COLOR="Red"]End If[/COLOR]
    End With
    Unload Me
    Sheets("Transfert").Select
End Sub

J'ai modifié la procédure pour ne faire le tri que s'il existe plus de 3 lignes dans la feuille Transfert.
En fait, dans ta méthode de tri, il manquait un point "." devant Range("A4") et Range("J4").
 
Haut Bas