Ce petit programme est une sorte d'alarme ou de réveil qui se déclenchera à l'heure souhaitée et émettra un son pour que vous ne soyez plus en retard.
Placer 2 TextBox Txthlim et Txthactu, 1 Bouton et 2 Timer.
Copier le code suivant dans le form.
Téléchargez le son d'alarme à cette adresse (il est inclu dans le ZIP)
http://perso.wanadoo.fr/steffiaume/telechargement/alarme.wav .
Source / Exemple :
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Const SND_ASYNC = &H1
Const SND_LOOP = &H8
Private Sub Command1_Click()
If Command1.Caption = "Lancer" Then
Txthactu.ForeColor = vbBlack
Txthlim.ForeColor = vbBlack
Command1.Caption = "Désactiver"
On Error GoTo erreur
Txthlim.Text = CDate(Txthlim.Text)
Timer2.Enabled = True
Exit Sub
erreur:
MsgBox "Erreur dans le format d'heure. Veuillez saisir une heure valide.", vbCritical, "Erreur..."
Command1.Caption = "Lancer"
Timer2.Enabled = False
Else
Command1.Caption = "Lancer"
Timer2.Enabled = False
End If
End Sub
Private Sub Alert()
sndPlaySound App.Path & "\alarme.wav", SND_ASYNC ' SND_LOOP Or
Txthactu.ForeColor = vbRed
Txthlim.ForeColor = vbRed
Form1.WindowState = 0
MsgBox "Alerte ! ! !", vbCritical, "Alerte"
Command1.Caption = "Lancer"
End Sub
Private Sub Form_Load()
With Form1
.Width = 3030
.Height = 1950
.BorderStyle = 1
.Caption = "Alarme"
End With
With Command1
.Width = 1095
.Height = 375
.Top = 1080
.Left = 840
.Caption = "Lancer"
End With
With Timer1
.Interval = 1000
End With
With Timer2
.Interval = 1000
.Enabled = False
End With
With Txthactu
.Width = 1215
.Height = 405
.Top = 120
.Left = 1440
.Text = ""
.Font.Size = "14"
.Enabled = False
End With
With Txthlim
.Width = 1695
.Height = 405
.Top = 600
.Left = 1200
.Text = "HH:MM:SS"
.MaxLength = 8
.Font.Size = "14"
End With
End Sub
Private Sub Timer2_Timer()
If Command1.Caption = "Désactiver" Then
Dim Hactu As Date, Hlim As Date
Hactu = Time
Hlim = Txthlim.Text
If Hactu > Txthlim.Text Then Alert
End If
End Sub
Private Sub Timer1_Timer()
Txthactu.Text = Time
End Sub
Private Sub Txthlim_Click()
With Txthlim
.Width = 1215
.Height = 405
.Left = 1440
.Text = ""
End With
End Sub
Conclusion :
N'oubliez pas de visiter mes sites :
http://perso.wanadoo.fr/steffiaume/ et
http://troccd.ifrance.com/
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.