listview par date !

deado · 17 Février 2009

bonsoir le forum
je suis de retour avec une petite question ....
en piece jointe, j'ai mis un autre fichier qui n'est pas le mien que j'ai récuperer sur le forum pour ne pas avoir a modifier le mien pour le poster ....
le principe est le méme ( je me suis inspirer de cette exemple )
j'ai juste rajouter 2 OptionButton ...
avec ces 2 option, je veut affichier soit toute la liste, soit juste les prochaine date .... merci d'avance pour celui ou ceux qui m'aiderons

jp14 · 17 Février 2009

Re : listview par date !

Bonjour

ci dessous la procédure pour trouver les anniversaires du jour ou de la semaine en fonction du code associée à la procédure.

Code:

Sub Anniversaire2(choix As Byte)
Dim y As Integer
Dim Valeur As Range
Dim Resultat As String
Dim date1 As Date
Dim date2 As Date
Dim trouve As Boolean
Dim jour As Integer
Dim i As Byte

date1 = Format(Now, "dd/mm/yyyy")
y = Sheets("feuil2").Range("A65536").End(xlUp).Row
Resultat = "Aniversaires du jour : " & Chr(10) & Chr(10)
If choix = 2 Then
Resultat = "Aniversaires de la semaine : " & Chr(10) & Chr(10)
End If

For Each Valeur In Sheets("feuil2").Range("J2:J" & y)
        Select Case choix
            Case 1
                If Month(Valeur) = Month(date1) And Day(Valeur) = Day(date1) Then
                
                            Resultat = Resultat & _
                            Valeur.Offset(0, -8) & " " & Valeur.Offset(0, -9) & Chr(10)
                            trouve = True
                
                    End If
            Case 2

                If Month(Valeur) = Month(date1) Then
                    date2 = date1
                    For i = 1 To 7
                        If Month(Valeur) = Month(date2) And Day(Valeur) = Day(date2) Then
                    
                                Resultat = Resultat & _
                                Valeur.Offset(0, -8) & " " & Valeur.Offset(0, -9) & Chr(10)
                                trouve = True
                    
                        End If
                        ' on passe à la date suivante
                        date2 = DateAdd("d", i, date1)
                    Next i
                End If
            Case Else
            End Select

Next Valeur
If trouve = False Then
'message à modifier pour indiquer qu'il n'y a pas d'anniversaire
Call MsgBox(" pas d'anniversaire", vbExclamation, Application.Name)
    Else
MsgBox Resultat, , "Message"
End If
End Sub

Anniversaire2(1) pour le jour
Anniversaire2(2) pour les 7 jours

A tester et à modifier

JP

deado · 17 Février 2009

Re : listview par date !

merci pour ta repense, mais je crois que c'est pas se que je cherche a avoir ....
méme si j'ai pas essayé, se que je cherche c'est d'afficher les resultats dans la listview et pas seulement les message .....

jp14 · 17 Février 2009

Re : listview par date !

Bonjour

Ci dessous la procédure pour la listview, le code est le même que pour l'affichage, seule l'action réalisé change.

A modifier

Code:

'-------------------------------------------------------------------------------------
' Module    : UserForm1/CommandButton7_Click
' DateTime  : 17/02/2009 / 19:51
' Bouton          :anniversaire du jour
'-------------------------------------------------------------------------------------
Private Sub CommandButton7_Click()
Dim y As Integer
Dim Valeur As Date
Dim Resultat As String
Dim date1 As Date
Dim date2 As Date
Dim trouve As Boolean
Dim jour As Integer
Dim i As Integer
Dim i1 As Byte
Dim choix As Byte
choix = 1
date1 = Format(Now, "dd/mm/yyyy")
y = Sheets("feuil2").Range("A65536").End(xlUp).Row
For i = ListView1.ListItems.Count To 1 Step -1
    If IsDate(ListView1.ListItems(i).ListSubItems(9).Text) Then
        Valeur = CDate(ListView1.ListItems(i).ListSubItems(9).Text)

        Select Case choix
            Case 1
                If Month(Valeur) = Month(date1) And Day(Valeur) = Day(date1) Then
                
                            trouve = True
                
                    End If
            Case 2

                If Month(Valeur) = Month(date1) Then
                    date2 = date1
                    For i1 = 1 To 7
                        If Month(Valeur) = Month(date2) And Day(Valeur) = Day(date2) Then
                    
                               trouve = True
                    
                        End If
                        ' on passe à la date suivante
                        date2 = DateAdd("d", i1, date1)
                    Next i1
                End If
            Case Else
            End Select
    
    End If
    If trouve = False Then
        ListView1.ListItems.Remove i
    End If
    trouve = False
Next i



End Sub

A tester

JP

deado · 17 Février 2009

Re : listview par date !

merci beaucoup ca marche tres bien, je vais essayé de l'adapter a mon fichier

deado · 17 Février 2009

Re : listview par date !

oups petit probleme, si j'ai les date sur la colonne B ( qui est la 1er colonne) si je remplace :

Code:

f IsDate(ListView1.ListItems(i).ListSubItems(9).Text) Then
        Valeur = CDate(ListView1.ListItems(i).ListSubItems(9).Text)

par

Code:

f IsDate(ListView1.ListItems(i).ListSubItems(0).Text) Then
        Valeur = CDate(ListView1.ListItems(i).ListSubItems(0).Text)

ca me met un message d'erreur index hors limites .... pourquoi?

jp14 · 18 Février 2009

Re : listview par date !

Bonjour

deado à dit:
oups petit probleme, si j'ai les date sur la colonne B ( qui est la 1er colonne) si je remplace :

Code:

f IsDate(ListView1.ListItems(i).ListSubItems(0).Text) Then Valeur = CDate(ListView1.ListItems(i).ListSubItems(0).Text)

ca me met un message d'erreur index hors limites .... pourquoi?

Il faut écrire
ListView1.ListItems(i).Text

JP

deado · 18 Février 2009

Re : listview par date !

c'est incroyable comment un petit truc de rien du tout peut tout changer
merci beaucoup ca marche tres bien comme ça

listview par date !

deado

XLDnaute Junior

Pièces jointes

jp14

XLDnaute Barbatruc

deado

XLDnaute Junior

jp14

XLDnaute Barbatruc

deado

XLDnaute Junior

deado

XLDnaute Junior

jp14

XLDnaute Barbatruc

deado

XLDnaute Junior

Discussions similaires