S
Stephane
Guest
Bonsoir à tous,
Le problème suivant m' amène à vous consulter. A l' aide d' un bouton situé sur une feuille de mon classeur, je fais apparaître un USF contenant un calendrier ( DTPicker1) qui me permet de choisir une date. Ensuite en cliquant sur le bouton 'chercher' de cet USF, j' ouvre une base située sur un autre disque et je copie les lignes de cette base contenant la date choisie.
Tout fonctionne bien tant que la date choisie existe dans la base.
Par contre si elle n' existe pas, je tombe sur la fenêtre de débogage.
Je voudrais donc afin d' éviter cette fenêtre introduire un MsgBox dans le code du bouton qui indique que la valeur cherchée n' existe pas. Et là je bloque.
Voilà le code du bouton 'chercher' :
Private Sub CommandButton1_Click()
Dim Wb As Workbooks
Dim C As Range, rng2 As Range
Application.ScreenUpdating = False
Workbooks.Open ('E:\\base.xls')
Application.WindowState = xlMaximized
For Each C In Range('h2:h' & Range('h65536').End(xlUp).Row)
If CDate(C.Value) = CDate(DTPicker1.Value) Then
If rng2 Is Nothing Then
Set rng2 = C.EntireRow
Else
Set rng2 = Union(rng2, C.EntireRow)
End If
End If
Next C
rng2.Select
Unload UserForm8
rng2.Copy
End Sub
Merci pour vos idées.
Le problème suivant m' amène à vous consulter. A l' aide d' un bouton situé sur une feuille de mon classeur, je fais apparaître un USF contenant un calendrier ( DTPicker1) qui me permet de choisir une date. Ensuite en cliquant sur le bouton 'chercher' de cet USF, j' ouvre une base située sur un autre disque et je copie les lignes de cette base contenant la date choisie.
Tout fonctionne bien tant que la date choisie existe dans la base.
Par contre si elle n' existe pas, je tombe sur la fenêtre de débogage.
Je voudrais donc afin d' éviter cette fenêtre introduire un MsgBox dans le code du bouton qui indique que la valeur cherchée n' existe pas. Et là je bloque.
Voilà le code du bouton 'chercher' :
Private Sub CommandButton1_Click()
Dim Wb As Workbooks
Dim C As Range, rng2 As Range
Application.ScreenUpdating = False
Workbooks.Open ('E:\\base.xls')
Application.WindowState = xlMaximized
For Each C In Range('h2:h' & Range('h65536').End(xlUp).Row)
If CDate(C.Value) = CDate(DTPicker1.Value) Then
If rng2 Is Nothing Then
Set rng2 = C.EntireRow
Else
Set rng2 = Union(rng2, C.EntireRow)
End If
End If
Next C
rng2.Select
Unload UserForm8
rng2.Copy
End Sub
Merci pour vos idées.