msg erreur 1004

[damien]

bonjour le le forum
lorsque j'indique une date qui n'est pas sur ma feuille une me renvoi une erreur 1004 et je voudrai qu'il m'affiche un msgbox 'saisir une autre date'.
Voici ma macro

ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
Selection.Sort Key1:=Range('A17'), Order1:=xlAscending, Key2:=Range('G17' _
), Order2:=xlAscending, Key3:=Range('C17'), Order3:=xlDescending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom


ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Label2.Visible = False

ListBox1.Clear

ListBox1.ColumnCount = 9
ListBox1.ColumnWidths = '60;130;110;60;60;110;80;200;200'
ListBox1.ColumnHeads = True


Dim TheDate As Date ' Déclare les variables.
Dim Msg
Dim c As Range
TheDate = InputBox('Entrez une date (jj/mm/aaa)')


Label2 = Date - DateDiff('d', TheDate, Now)
Label3 = 'Récapitulatif contrôles depuis le :' & TheDate




lafin = Worksheets('base peche').Range('A65536').End(xlUp).Row + 1
For N = 1 To lafin
If Worksheets('base peche').Range('A' & N) = CDate(Label2) Then
Debut = N
Exit For
End If
Next N
For N = Debut To lafin
ListBox1.AddItem Worksheets('base peche').Range('A' & N)
Next N
For N = 1 To ListBox1.ListCount - 1
ListBox1.List(N - 1, 1) = Worksheets('base peche').Range('c' & N + Debut - 1)
ListBox1.List(N - 1, 2) = Worksheets('base peche').Range('d' & N + Debut - 1)
ListBox1.List(N - 1, 3) = Worksheets('base peche').Range('e' & N + Debut - 1)
ListBox1.List(N - 1, 4) = Worksheets('base peche').Range('f' & N + Debut - 1)
ListBox1.List(N - 1, 5) = Worksheets('base peche').Range('g' & N + Debut - 1)
ListBox1.List(N - 1, 6) = Worksheets('base peche').Range('j' & N + Debut - 1)
ListBox1.List(N - 1, 7) = Worksheets('base peche').Range('o' & N + Debut - 1)
ListBox1.List(N - 1, 8) = Worksheets('base peche').Range('p' & N + Debut - 1)


Next N

End Sub



merci damien

 

[pierrejean]

bonjour damien
teste d'ajouter la ligne

if N=lafin then exit sub
comme ci-dessous



For N = 1 To lafin
If Worksheets('base peche').Range('A' & N) = CDate(Label2) Then
Debut = N
Exit For
End If

if N=lafin+1 then exit sub



Next N
For N = Debut To lafin
ListBox1.AddItem Worksheets('base peche').Range('A' & N)
Next N

edit:
c'est lafin+1 au lieu de lafin !!

Message édité par: pierrejean, à: 19/06/2006 17:40

 

[Damien]

bjr pierrejean et merci


alors par moment je n'est rien .Exemple le 26/04 ou le 28/04.Alors j'inscris une de ces dates il me renvoi une erreur, si je fais annuler ou je ferme a la croix pareil erreur.
Je voudrai une msgbox 'saisir une autre date'.

merci

damien

 

[pierrejean]

re damien

difficile sans fichier !!!

teste:

if N=lafin+1 then
msgbox('Mettez une autre date S.V.P')
exit sub

si tu as toujours une erreur donne le texte de l'erreur et eventuellement la ligne surlignée de jaune du debogueur

 

[Damien]

je peux plus mettre de piece jointe
voici la liste sur feuille 'base peche':

lundi 24 avril 2006 1445 CONTRÔLE DEBARQUE
mardi 25 avril 2006 1800 CONTRÔLE A BORD
samedi 29 avril 2006 CONTRÔLE A BORD
samedi 29 avril 2006 1710 CONTRÔLE POSITION
dimanche 30 avril 2006 1722 CONTRÔLE POSITION
lundi 01 mai 2006 1151 IDENTIFICATION
lundi 01 mai 2006 1305 IDENTIFICATION
mardi 02 mai 2006 0940 CONTRÔLE A BORD
mardi 02 mai 2006 1714 CONTRÔLE A BORD
mardi 02 mai 2006 2230 CONTRÔLE A BORD
mercredi 03 mai 2006 0007 CONTRÔLE A BORD
mercredi 03 mai 2006 1625 CONTRÔLE A BORD
jeudi 04 mai 2006 1545 CONTRÔLE DEBARQUE
jeudi 04 mai 2006 2000 CONTRÔLE A BORD
jeudi 04 mai 2006 0830 CONTRÔLE DEBARQUE
vendredi 05 mai 2006 0050 CONTRÔLE A BORD
vendredi 05 mai 2006 2330 CONTRÔLE A BORD
samedi 06 mai 2006 CONTRÔLE A BORD
samedi 06 mai 2006 1630 CONTRÔLE A BORD
samedi 06 mai 2006 0200 CONTRÔLE A BORD
samedi 06 mai 2006 1545 CONTRÔLE POSITION
dimanche 07 mai 2006 1030 CONTRÔLE A BORD
mardi 09 mai 2006 1000 CONTRÔLE A BORD
mercredi 10 mai 2006 CONTRÔLE A BORD
vendredi 12 mai 2006 1625 CONTRÔLE POSITION
vendredi 12 mai 2006 1621 CONTRÔLE POSITION
samedi 13 mai 2006 0440 CONTRÔLE DEBARQUE
samedi 13 mai 2006 0930 CONTRÔLE A BORD
samedi 13 mai 2006 0450 CONTRÔLE DEBARQUE
lundi 15 mai 2006 CONTRÔLE POSITION
lundi 15 mai 2006 1230 CONTRÔLE DEBARQUE
mardi 16 mai 2006 1420 CONTRÔLE DEBARQUE
mardi 16 mai 2006 CONTRÔLE A BORD
mardi 16 mai 2006 CONTRÔLE A BORD
mercredi 17 mai 2006 1000 CONTRÔLE A BORD
mercredi 17 mai 2006 CONTRÔLE A BORD
mercredi 17 mai 2006 1510 CONTRÔLE A BORD
mercredi 17 mai 2006 1610 CONTRÔLE A BORD
mercredi 17 mai 2006 2ème et dernière infraction
jeudi 18 mai 2006 1145 CONTRÔLE POSITION
mardi 23 mai 2006 CONTRÔLE A BORD
mardi 23 mai 2006 CONTRÔLE A BORD
mardi 23 mai 2006 1430 CONTRÔLE A BORD
vendredi 19 mai 2006 0530 CONTRÔLE DEBARQUE
mercredi 24 mai 2006 CONTRÔLE DEBARQUE
mercredi 24 mai 2006 CONTRÔLE DEBARQUE
vendredi 26 mai 2006 1236 CONTRÔLE POSITION
vendredi 26 mai 2006 1241 CONTRÔLE POSITION
samedi 27 mai 2006 1315 INTERROGATION VHF
dimanche 28 mai 2006 0954 CONTRÔLE A BORD
dimanche 28 mai 2006 0900 CONTRÔLE A BORD
lundi 29 mai 2006 1025 CONTRÔLE DEBARQUE
lundi 29 mai 2006 2100 CONTRÔLE A BORD
mardi 30 mai 2006 0745 CONTRÔLE A BORD
lundi 19 juin 2006 0652 CONTRÔLE A BORD




et la macro


Private Sub UserForm_Initialize()
Label2.Visible = False

ListBox1.Clear

ListBox1.ColumnCount = 9
ListBox1.ColumnWidths = '60;130;110;60;60;110;80;200;200'
ListBox1.ColumnHeads = True


Dim TheDate As Date ' Déclare les variables.
Dim Msg
Dim c As Range
TheDate = InputBox('Entrez une date (jj/mm/aaa)')


Label2 = Date - DateDiff('d', TheDate, Now)
Label3 = 'Récapitulatif contrôles depuis le :' & TheDate




lafin = Worksheets('base peche').Range('A65536').End(xlUp).Row + 1
For N = 1 To lafin
If Worksheets('base peche').Range('A' & N) = CDate(Label2) Then
Debut = N
Exit For
End If
Next N
For N = Debut To lafin
ListBox1.AddItem Worksheets('base peche').Range('A' & N)
Next N
For N = 1 To ListBox1.ListCount - 1
ListBox1.List(N - 1, 1) = Worksheets('base peche').Range('c' & N + Debut - 1)
ListBox1.List(N - 1, 2) = Worksheets('base peche').Range('d' & N + Debut - 1)
ListBox1.List(N - 1, 3) = Worksheets('base peche').Range('e' & N + Debut - 1)
Next N

End Sub

mon userform listbox1, label1 et label2

merci

 

[pierrejean]

re damien

voila modifiée la macro que je t'avais proposée avec traitement des erreurs d'entrée de date

Sub auto_open()
Dim TheDate As Date ' Déclare les variables.
Dim Msg
Dim c As Range
reponse = InputBox('Entrez une date (jj/mm/aaaa)', 'La Date', Sheets('Feuil1').Range('A1'))
If IsDate(reponse) Then
TheDate = reponse
UserForm1.Label2 = Date - DateDiff('d', TheDate, Now)
lafin = Worksheets('Feuil1').Range('A65536').End(xlUp).Row
For n = 1 To lafin
If Worksheets('Feuil1').Range('A' & n) = CDate(UserForm1.Label2) Then
Debut = n
Exit For
End If
Next n
If n = lafin + 1 Then
MsgBox ('La date n'existe pas')
Call auto_open
Else
For n = Debut To lafin
UserForm1.ListBox1.AddItem Worksheets('Feuil1').Range('A' & n)
Next n
For n = 1 To UserForm1.ListBox1.ListCount - 1
UserForm1.ListBox1.List(n - 1, 1) = Worksheets('Feuil1').Range('B' & n + Debut - 1)
UserForm1.ListBox1.List(n - 1, 2) = Worksheets('Feuil1').Range('C' & n + Debut - 1)
Next n
UserForm1.Show
End If
Else
If reponse = '' Then
Exit Sub
Else
MsgBox ('Entrez une date valable')
Call auto_open
End If

End If
End Sub

 

[damien]

bonjour merci
si je ne veux pas qu'il soit en auto open mais activer à partir d'un userForm_Initialize.Je dois remplacer auto_open par userForm_Initialize.

merci
damien

 

[damien]

re bonsoir
merci pierre jean
damien