ce prog vous permet de gerer vos CD de tout genre et aussi de gerer les prets de vos CD.
Il permet aussi en cas de retard dans le retour d'un pret d'envoyer un email a la personne concerné avec un resumé du pret.
Source / Exemple :
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "user32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Private Sub agrandir_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
agrandir.Picture = ImageList1.ListImages(2).Picture
fermer.Picture = ImageList1.ListImages(5).Picture
reduir.Picture = ImageList1.ListImages(3).Picture
End Sub
Private Sub brtitre_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ValRetourLng As Long
If Button = 1 Then
Call ReleaseCapture
ValRetourLng = SendMessage(Form2.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
btn_org
End Sub
Private Sub C_Click()
On Error GoTo oups
Adodc1.RecordSource = "SELECT * FROM pret ORDER BY nom"
Adodc1.Refresh
oups:
End Sub
Private Sub fermer_Click()
Unload Me
Form6.Show
End Sub
Private Sub fermer_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
fermer.Picture = ImageList1.ListImages(6).Picture
reduir.Picture = ImageList1.ListImages(3).Picture
agrandir.Picture = ImageList1.ListImages(1).Picture
End Sub
Private Sub btn_org()
'initialisation des bouton
fermer.Picture = ImageList1.ListImages(5).Picture
reduir.Picture = ImageList1.ListImages(3).Picture
agrandir.Picture = ImageList1.ListImages(1).Picture
End Sub
Private Sub Form_Load()
Me.Width = 8535
Me.Height = 4815
With Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & LireINI("BDinf", "chemin") & ";Mode=ReadWrite;Persist Security Info=False"
.RecordSource = "pret"
End With
Adodc1.Refresh
Label21.Caption = LireINI("BDinf", "encours") & " pret(s) en cours."
C.Value = True
compt_ghe
retard_verif
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
btn_org
End Sub
Private Sub Label1_Click()
'ajout d'un enregistrement
On Error GoTo oups
If Label1.Caption = "nouveau" Then
Adodc1.Recordset.AddNew
Label1.Caption = "valider"
Text1.Locked = False
Text2.Locked = False
Text3.Locked = False
Text4.Locked = False
Text5.Locked = False
Text6.Locked = False
Text7.Locked = False
text8.Locked = False
Text9.Locked = False
Text10.Locked = False
Text11.Locked = False
Text12.Locked = False
Else
Dim Lbl As String
Label15.Caption = LireINI("BDinf", "encours")
Label15.Caption = Val(Label15.Caption) + 1
b = EcrireINI("BDinf", "encours", Label15.Caption)
Adodc1.Recordset.MoveFirst
Label1.Caption = "nouveau"
Text1.Locked = True
Text2.Locked = True
Text3.Locked = True
Text4.Locked = True
Text5.Locked = True
Text6.Locked = True
Text7.Locked = True
text8.Locked = True
Text9.Locked = True
Text10.Locked = True
Text11.Locked = True
Text12.Locked = True
C.Value = True
compt_ghe
End If
Label21.Caption = LireINI("BDinf", "encours") & " pret(s) en cours."
oups:
End Sub
Private Sub Label14_Click()
On Error GoTo oups
If Adodc1.Recordset.AbsolutePosition <> "-1" Then
Form4.Show
Form4.Label2.Caption = Text1.Text & " " & Text2.Text
Form4.Label3.Caption = Text12.Text
Timer3.Interval = 500
End If
oups:
End Sub
Private Sub Label19_Click()
'deplacement dans la base de donnée vers l'enregistrement suivant
On Error GoTo oups
If Adodc1.Recordset.RecordCount <> 0 Then
If Adodc1.Recordset.AbsolutePosition < Adodc1.Recordset.RecordCount Then
Adodc1.Recordset.MoveNext
compt_ghe
retard_verif
Else
Form5.Show
End If
Else
Form5.Show
End If
oups:
If Err.Number <> 0 Then
MsgBox Err.Number & vbNewLine & Err.Description
Exit Sub
End If
End Sub
Private Sub Label20_Click()
'deplacement dans la base de donnée vers le precedent enregistrement
On Error GoTo oups
If Adodc1.Recordset.AbsolutePosition > 1 Then
Adodc1.Recordset.MovePrevious
compt_ghe
retard_verif
Else
Form5.Show
End If
oups:
If Err.Number <> 0 Then
MsgBox Err.Number & vbNewLine & Err.Description
Exit Sub
End If
End Sub
Private Sub Label22_Click()
'modifier l'enregistrement actif
If Label22.Caption = "modifier" Then
Text1.Locked = False
Text2.Locked = False
Text3.Locked = False
Text4.Locked = False
Text5.Locked = False
Text6.Locked = False
Text7.Locked = False
text8.Locked = False
Text9.Locked = False
Text10.Locked = False
Text11.Locked = False
Text12.Locked = False
Label22.Caption = "valider"
Else
Text1.Locked = True
Text2.Locked = True
Text3.Locked = True
Text4.Locked = True
Text5.Locked = True
Text6.Locked = True
Text7.Locked = True
text8.Locked = True
Text9.Locked = True
Text10.Locked = True
Text11.Locked = True
Text12.Locked = True
Label22.Caption = "modifier"
Adodc1.Recordset.MoveFirst
compt_ghe
End If
End Sub
Private Sub reduir_Click()
Me.WindowState = 1
btn_org
End Sub
Private Sub agrandir_Click()
If Me.Height > 320 Then
Timer1.Interval = 1
Else
Timer2.Interval = 1
End If
btn_org
End Sub
Private Sub reduir_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
reduir.Picture = ImageList1.ListImages(4).Picture
fermer.Picture = ImageList1.ListImages(5).Picture
agrandir.Picture = ImageList1.ListImages(1).Picture
End Sub
Private Sub Timer1_Timer()
If Me.Height >= 320 Then
Me.Height = Me.Height - 100
Else
Timer1.Interval = 0
Me.Height = 320
End If
End Sub
Private Sub Timer2_Timer()
If Me.Height <= 4815 Then
Me.Height = Me.Height + 100
Else
Timer2.Interval = 0
Me.Height = 4815
End If
End Sub
Private Sub compt_ghe()
'initialisation
gl2.Width = 0
gl1.Width = 3120
gl2.Left = gl1.Left
aff1.Caption = Adodc1.Recordset.AbsolutePosition & " / " & Adodc1.Recordset.RecordCount
If Adodc1.Recordset.RecordCount <> "0" Then
ec1.Text = 3120 / Val(Adodc1.Recordset.RecordCount)
gl2.Width = Val(Adodc1.Recordset.AbsolutePosition) * Val(ec1.Text)
End If
End Sub
Private Sub Timer3_Timer()
If Form4.Visible = False Then
compt_ghe
Timer3.Interval = 0
End If
End Sub
Private Sub retard_verif()
On Error GoTo oups
If Text9.Text <> vbNullString Then
'recuperation jours mois années
Dim an As Integer
an = Val(Mid(Text9.Text, 7, 2))
Dim mois As Integer
mois = Val(Mid(Text9.Text, 4, 2))
Dim jour As Integer
jour = Val(Mid(Text9.Text, 1, 2))
'verification retard
'If Format(Date, "yy") <= an Then
If Format(Date, "mm") <= mois Then
If Format(Date, "d") <= jour Then
'MsgBox "pas en retard"
Else
mail_to jour, mois, an
End If
Else
mail_to jour, mois, an
End If
'Else
' mail_to jour, mois, an
'End If
End If
oups:
End Sub
Private Sub mail_to(ByVal jour As Integer, ByVal mois As Integer, ByVal an As Integer)
On Error GoTo oups:
'recuperation des jours mois années
Dim retard As Integer
mois2 = (Val(Format(Date, "mm")) - mois)
jour2 = (Val(Format(Date, "dd")) - jour)
'verification si envoi auto ou non
If LireINI("conf", "auto") <> 1 Then
'si pas d'envoi auto simple affichage puis on quitte la fonction
MsgBox Text2.Text & " " & Text1.Text & " à " & jour2 & " jour(s), " & mois2 & _
" mois de retard", vbCritical
Exit Sub
End If
'demande d'envoi ou non d'email
rep = MsgBox(Text2.Text & " " & Text1.Text & " à " & jour2 & " jour(s), " & mois2 & _
" mois de retard" & vbNewLine & vbNewLine & _
"Voulez vous envoyer un mail de rappel", vbYesNo, "Rappel")
If rep = vbYes Then
'generation de la lettre de rappel
Dim Msg As String
Msg = "Lettre de Rappel, pour " & text8.Text & " non rendu." & vbNewLine & vbNewLine & _
Text2.Text & " " & Text1.Text & ", vous avez emprunté " & text8.Text & "," & vbNewLine & _
"à " & LireINI("email", "nom") & ", le " & Text10.Text & "." & vbNewLine & vbNewLine & _
"Actuellement vous avez " & jour2 & " jour(s), " & mois2 & " mois de retard" & _
vbNewLine & vbNewLine & " Detail du pret : " & vbNewLine & Text11.Text & vbNewLine & vbNewLine & "Cordialement " & LireINI("email", "nom") & "." & _
vbNewLine & vbNewLine & "[lettre de rappel automatique de GstX GestionCortex"
'timer de verification de l'etat du winsock
Timer4.Interval = 100
'ajout de la signature
If LireINI("conf", "sign") = 1 Then
Msg = Msg & vbNewLine & LireINI("autre", "sign")
End If
'envoi du mail
If Text7.Text <> vbNullString Then
'si le l'adresse existe
Envoyer Form2.Winsock1, LireINI("email", "nom"), LireINI("email", "mail"), " ", Text7.Text, Msg & _
vbNewLine & vbNewLine & "[ Mail envoyé à partir du logiciel GestionCortex de NeoCortex ]" & vbNewLine & "[ Copyright NC2003 www.wcx.fr.st ]", "Rappel de pret(s)", LireINI("email", "smtp")
Else
'si l'adresse n'existe pas
MsgBox "Aucune Adresse Email pour :" & vbNewLine & Text2.Text & " " & Text1.Text, vbCritical, "Opération annuler"
End If
End If
'en ca s d'erreur
oups:
End Sub
Private Sub Timer4_Timer()
If Winsock1.State = 8 Then
MsgBox "Email envoyer...", vbExclamation, "Etat"
Timer4.Interval = 0
End If
End Sub
Conclusion :
Bonne prog
NeoCortex
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.