Introduction
Cette partie du mémoire présente la base de
données en oracle et l?application en Vb 6.0. La base de données
oracle nous présente les routines déjà invoquées
dans la deuxième partie du travail et l?application met en
évidence des propos du langage de programmation et de l?optimisation du
code de la troixième partie.
70
Chapitre I : La base de données oracle
La base de données présentée est
conçue en oracle, elle gère les employés et les clients.
Cette base de données oracle qui nous montre les routines
d?optimisations comme les vues, les clés secondaires...
1-Connexion à oracle
2-Les tables de la base
a-Table S_DEPT & Enregistrement s
b-Table S_EMP & les Enregistrements
72
c-Table S_DUAL & Enregistrement s
d-Table S_REGION & Enregistrement s
e-Table S_CUSTOMER & Enregistrement s
74
f-Table S_TITLE & Enregistrement s
76
Chapitre II : L?application VB
L?application que nous avons choixie d?optimiser est une
application développée en Visual basic version 6.0. Cette
application se connecte avec une base de données oracle pour
gérer les employés d?une société et ces clients.
Dans le cas de notre travail, cette application parait
intéressante, pour montrer au concepteur la modularité de son
code, les routines de performance que nous avons mise en évidence et en
plus les interfaces de celui-ci.
1-connexion a-Conception
b-module
Option Explicit
Public db As New ADODB.Connection Public uid As String
Public pwd As String
Public dBase As String
Public connected As Integer
78
Sub OracleConnect()
On Error GoTo logonError
connected = 0
Dim Conn As String
Dim drv As String
uid = Trim$(FRMConnexion.txtUserId.Text) pwd =
Trim$(FRMConnexion.txtPassword.Text)
dBase = Trim$(FRMConnexion.txtDatabase.Text) Set db = New
ADODB.Connection
With FRMConnexion
If .txtUserId.Text = "" Then
MsgBox "Entrez le nom d'Utilisateur", vbExclamation
.txtUserId.SetFocus
Exit Sub
ElseIf .txtPassword.Text = "" Then
MsgBox "Entrez le Mot de Passe", vbExclamation
.txtPassword.SetFocus
Exit Sub End If
If .txtDatabase.Text <> "" Then
Conn = "UID= " & uid & ";PWD=" & pwd &
";DRIVER={Microsoft ODBC
For Oracle};" _
& "SERVER=" & dBase & ";"
Else
Conn = "UID= " & uid & ";PWD=" & pwd &
";DRIVER={Microsoft ODBC
For Oracle};"
End If
End With
Screen.MousePointer = vbHourglass With db
.ConnectionString = Conn
.CursorLocation = adUseClient .Open
End With
connected = 1
Screen.MousePointer = vbDefault logonError:
If Err.Number <> 0 Then
Screen.MousePointer = vbDefault
MsgBox "Redémarrer le Programme si une erreur c'est
produite. Error
Description:" & Err.Description & "", vbCritical
connected = 0
With FRMConnexion
.txtUserId.Text = vbNullString
.txtPassword.Text = vbNullString .txtDatabase.Text =
vbNullString .txtUserId.SetFocus
End With
Else
80
Screen.MousePointer = vbDefault
Unload FRMConnexion
End If End Sub c-Code Option Explicit
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOk_Click()
OracleConnect
End Sub
c-Execution
2-Menu
a-Mode conception
b-Code
Private Sub client_Click() If connected = 1 Then
82
FRMCustomer.Show
Else
MsgBox "Vous devez d'abord vous connectez" End If
End Sub
Private Sub connexion_Click() FRMConnexion.Show
End Sub
Private Sub conregion_Click()
If connected = 1 Then
FRMConsRégion.Show
Else
MsgBox "Vous devez d'abord vous connectez" End If
End Sub
Private Sub consclient_Click()
If connected = 1 Then FRMConsClient.Show Else
MsgBox "Vous devez d'abord vous connectez" End If
End Sub
Private Sub consdept_Click()
If connected = 1 Then
FRMConsDept.Show
Else
MsgBox "Vous devez d'abord vous connectez" End If
End Sub
Private Sub consemp_Click()
If connected = 1 Then
FRMConsEmp.Show
Else
MsgBox "Vous devez d'abord vous connectez" End If
End Sub
Private Sub dept_Click()
If connected = 1 Then
FRMDept.Show
Else
MsgBox "Vous devez d'abord vous connectez" End If
End Sub
Private Sub emp_Click() If connected = 1 Then
84
FRMEmp.Show
Else
MsgBox "Vous devez d'abord vous connectez" End If
End Sub
Private Sub Form_Load()
End Sub
Private Sub quitter_Click() End
End Sub
Private Sub Region_Click()
If connected = 1 Then
FRMRégion.Show
Else
MsgBox "Vous devez d'abord vous connectez" End If
End Sub
c-Exécution du Menu
3-Département a-mode conception
86
b-Module
Sub InsertDept()
Dim adoCommand As ADODB.Command
Dim adoRecordSet As ADODB.Recordset
On Error GoTo InsertDept
Set adoCommand = New ADODB.Command
With adoCommand
.CommandType = adCmdText .ActiveConnection = db
.CommandText = "SELECT ID,NAME,REGION_ID FROM S_DEPT"
End With
Set adoRecordSet = New ADODB.Recordset
adoRecordSet.Open adoCommand, , adOpenStatic, adLockOptimistic
adoRecordSet.AddNew
adoRecordSet!ID = FRMDept.D(0).Text
adoRecordSet!Name = FRMDept.D(1).Text
adoRecordSet!region_id = FRMDept.rg
Call adoRecordSet.Update Set adoRecordSet = Nothing Set
adoCommand = Nothing Exit Sub
InsertDept:
MsgBox "Ajout Error Description:" & Err.Description & "",
vbCritical End Sub
Sub DeleteDept()
Dim adoCommand As ADODB.Command
Dim adoRecordSet As ADODB.Recordset
On Error GoTo DeleteDept
Set adoCommand = New ADODB.Command
With adoCommand
.CommandType = adCmdText
.ActiveConnection = db
.CommandText = "SELECT ID,NAME,REGION_ID FROM S_DEPT" End With
Set adoRecordSet = New ADODB.Recordset
adoRecordSet.Open adoCommand, , adOpenStatic,
adLockOptimistic
Call adoRecordSet.Find("id =" & FRMDept.D(0).Text)
While Not adoRecordSet.EOF() adoRecordSet.Delete
adoRecordSet.MoveNext
Call adoRecordSet.Find("id =" & FRMDept.D(0).Text)
Wend
If adoRecordSet.RecordCount > 0 Then
adoRecordSet.MoveFirst End If
88
Call adoRecordSet.Update
Set adoRecordSet = Nothing Set adoCommand = Nothing Exit
Sub
DeleteDept:
MsgBox "Supression Error Description:" & Err.Description
& "", vbCritical End Sub
Sub UpdateDept()
Dim adoCommand As ADODB.Command Dim adoRecordSet As
ADODB.Recordset On Error GoTo UpdateDept
Set adoCommand = New ADODB.Command With adoCommand
.CommandType = adCmdText
.ActiveConnection = db
.CommandText = "SELECT ID,NAME,REGION_ID FROM S_DEPT"
End With
Set adoRecordSet = New ADODB.Recordset
adoRecordSet.Open adoCommand, , adOpenStatic, adLockOptimistic
Call adoRecordSet.Find("id =" & FRMDept.D(0).Text)
While Not adoRecordSet.EOF()
adoRecordSet!Name = FRMDept.D(1).Text adoRecordSet!region_id =
FRMDept.rg
adoRecordSet.MoveNext
Call adoRecordSet.Find("id =" & FRMDept.D(0).Text)
Wend
If adoRecordSet.RecordCount > 0 Then
adoRecordSet.MoveFirst End If
Call adoRecordSet.Update Set adoRecordSet = Nothing Set
adoCommand = Nothing Exit Sub
UpdateDept:
MsgBox "Modification Error Description:" & Err.Description
& "", vbCritical End Sub
c-code
Option Explicit
Dim rs2 As New ADODB.Recordset Dim sq2 As New ADODB.Recordset Dim
nb As New ADODB.Recordset Dim cmbrg As New ADODB.Recordset Dim cmbch As New
ADODB.Recordset Dim aj, up As Integer
Public rg As Integer
Private Sub Annuler_Click()
DRG.Clear
cmbnumreg.Clear
90
parcours.Enabled = True actions.Enabled = True validation.Enabled
= False premier.Enabled = True dernier.Enabled = True precedent.Enabled = True
suivant.Enabled = True nouveau.Enabled = True modifier.Enabled = True
supprimer.Enabled = True fermer.Enabled = True Valider.Enabled = False
Annuler.Enabled = False D(0).Enabled = False
D(1).Enabled = False
DRG.Enabled = False
rs2.MoveFirst
D(0).Text = rs2("id")
D(1).Text = rs2("Name")
cmbrg.Open "Select * from s_region where id=" &
rs2("region_id"), db,
adOpenDynamic, adLockBatchOptimistic
DRG.Text = cmbrg("name")
cmbrg.Close
On Error Resume Next
nb.Open "select count(*) from s_emp Where dept_id =" &
D(0).Text & "group
by dept_id", db, adOpenDynamic, adLockBatchOptimistic nb_emp =
""
nb_emp.Text = nb.Fields(0)
nb.Close
If nb_emp = "" Then
nb_emp.Text = 0
End If
aj = 0
up = 0
End Sub
Private Sub DRG_Click()
rg = cmbnumreg.List(DRG.ListIndex)
End Sub
Private Sub fermer_Click()
Me.Hide Unload Me
End Sub
Private Sub Form_Load()
Set cmbrg = New ADODB.Recordset
Set cmbch = New ADODB.Recordset
Set rs2 = New ADODB.Recordset
Set nb = New ADODB.Recordset
rs2.Open "Select * from s_dept", db, adOpenDynamic,
adLockBatchOptimistic rs2.MoveFirst
D(0).Text = rs2("id")
D(1).Text = rs2("Name")
cmbrg.Open "Select name from s_region where id=" &
rs2("region_id"), db
92
DRG.Text = cmbrg("name") cmbrg.Close
parcours.Enabled = True actions.Enabled = True validation.Enabled
= False premier.Enabled = True dernier.Enabled = True precedent.Enabled = True
suivant.Enabled = True nouveau.Enabled = True modifier.Enabled = True
supprimer.Enabled = True fermer.Enabled = True Valider.Enabled = False
Annuler.Enabled = False aj = 0
up = 0
On Error Resume Next
nb.Open "select count(*) from s_emp Where dept_id =" &
D(0).Text & "group
by dept_id", db, adOpenDynamic, adLockBatchOptimistic nb_emp =
""
nb_emp.Text = nb.Fields(0)
nb.Close
If nb_emp = "" Then
nb_emp.Text = 0
End If
End Sub
Private Sub Form_Unload(Cancel As Integer) rs2.Close
End Sub
Private Sub modifier_Click() parcours.Enabled = False
actions.Enabled = False validation.Enabled = True D(0).Enabled = False
D(1).Enabled = True
DRG.Enabled = True
aj = 0
up = 1
premier.Enabled = False dernier.Enabled = False precedent.Enabled
= False suivant.Enabled = False nouveau.Enabled = False modifier.Enabled =
False supprimer.Enabled = False fermer.Enabled = False Valider.Enabled = True
Annuler.Enabled = True
94
cmbch.Open "Select * from s_region", db, adOpenDynamic,
adLockBatchOptimistic
While Not cmbch.EOF()
DRG.AddItem (cmbch("name"))
cmbnumreg.AddItem (cmbch("id"))
cmbch.MoveNext
Wend cmbch.Close
End Sub
Private Sub nouveau_Click()
parcours.Enabled = False
actions.Enabled = False
validation.Enabled = True
D(0).Enabled = False
D(1).Enabled = True
DRG.Enabled = True
D(0).Text = "" D(1).Text = "" DRG.Text = "" aj = 1
up = 0
premier.Enabled = False
dernier.Enabled = False
precedent.Enabled = False
suivant.Enabled = False
nouveau.Enabled = False modifier.Enabled = False
supprimer.Enabled = False fermer.Enabled = False Valider.Enabled = True
Annuler.Enabled = True
D(0).Text = "Identifiant Automatique"
cmbch.Open "Select * from s_region", db, adOpenDynamic,
adLockBatchOptimistic
While Not cmbch.EOF()
DRG.AddItem (cmbch("name"))
cmbnumreg.AddItem (cmbch("id"))
cmbch.MoveNext
Wend cmbch.Close
End Sub
Private Sub precedent_Click() On Error Resume Next
D(0).Text = vbNullString D(1).Text = vbNullString DRG.Text =
vbNullString rs2.MovePrevious
D(0).Text = rs2("id")
D(1).Text = rs2("Name")
96
cmbrg.Open "Select * from s_region where id=" &
rs2("region_id"), db, adOpenDynamic, adLockBatchOptimistic
DRG.Text = cmbrg("name") cmbrg.Close
If D(0).Text = "" Then
rs2.MoveNext
D(0).Text = rs2("id")
D(1).Text = rs2("Name")
cmbrg.Open "Select * from s_region where id=" &
rs2("region_id"), db, adOpenDynamic, adLockBatchOptimistic
DRG.Text = cmbrg("name") cmbrg.Close
End If
On Error Resume Next
nb.Open "select count(*) from s_emp Where dept_id =" &
D(0).Text & "group by dept_id", db, adOpenDynamic, adLockBatchOptimistic
nb_emp = ""
nb_emp.Text = nb.Fields(0) nb.Close
If nb_emp = "" Then
nb_emp.Text = 0
End If
End Sub
Private Sub premier_Click() On Error Resume Next
D(0).Text = ""
D(1).Text = "" DRG.Text = "" rs2.MoveFirst D(0).Text =
rs2("id")
D(1).Text = rs2("Name")
cmbrg.Open "Select * from s_region where id=" &
rs2("region_id"), db,
adOpenDynamic, adLockBatchOptimistic
DRG.Text = cmbrg("name")
cmbrg.Close
On Error Resume Next
nb.Open "select count(*) from s_emp Where dept_id =" &
D(0).Text & "group
by dept_id", db, adOpenDynamic, adLockBatchOptimistic
nb_emp = ""
nb_emp.Text = nb.Fields(0)
nb.Close
If nb_emp = "" Then
nb_emp.Text = 0
End If
End Sub
Private Sub suivant_Click() On Error Resume Next
D(0).Text = vbNullString D(1).Text = vbNullString DRG.Text =
vbNullString rs2.MoveNext
98
D(0).Text = rs2("id") D(1).Text = rs2("Name")
cmbrg.Open "Select * from s_region where id=" &
rs2("region_id"), db, adOpenDynamic, adLockBatchOptimistic
DRG.Text = cmbrg("name") cmbrg.Close
If D(0).Text = "" Then
rs2.MovePrevious
D(0).Text = rs2("id")
D(1).Text = rs2("Name")
cmbrg.Open "Select * from s_region where id=" &
rs2("region_id"), db, adOpenDynamic, adLockBatchOptimistic
DRG.Text = cmbrg("name") cmbrg.Close
End If
On Error Resume Next
nb.Open "select count(*) from s_emp Where dept_id =" &
D(0).Text & "group by dept_id", db, adOpenDynamic, adLockBatchOptimistic
nb_emp = ""
nb_emp.Text = nb.Fields(0) nb.Close
If nb_emp = "" Then
nb_emp.Text = 0
End If
End Sub
Private Sub dernier_Click()
On Error Resume Next
rs2.MoveLast
D(0).Text = rs2("id")
D(1).Text = rs2("Name")
cmbrg.Open "Select * from s_region where id=" &
rs2("region_id"), db,
adOpenDynamic, adLockBatchOptimistic
DRG.Text = cmbrg("name")
cmbrg.Close
On Error Resume Next
nb.Open "select count(*) from s_emp Where dept_id =" &
D(0).Text & "group
by dept_id", db, adOpenDynamic, adLockBatchOptimistic
nb_emp = ""
nb_emp.Text = nb.Fields(0)
nb.Close
If nb_emp = "" Then
nb_emp.Text = 0
End If
End Sub
Private Sub supprimer_Click()
MAJDept.DeleteDept
rs2.Close
rs2.Open "Select * from s_dept", db, adOpenDynamic,
adLockBatchOptimistic rs2.MoveFirst
D(0).Text = rs2("id")
D(1).Text = rs2("Name")
100
cmbrg.Open "Select * from s_region where id=" &
rs2("region_id"), db, adOpenDynamic, adLockBatchOptimistic
DRG.Text = cmbrg("name") cmbrg.Close
On Error Resume Next
nb.Open "select count(*) from s_emp Where dept_id =" &
D(0).Text & "group by dept_id", db, adOpenDynamic, adLockBatchOptimistic
nb_emp = ""
nb_emp.Text = nb.Fields(0)
nb.Close
If nb_emp = "" Then
nb_emp.Text = 0
End If
End Sub
Private Sub Valider_Click()
DRG.Clear
cmbnumreg.Clear
parcours.Enabled = True
actions.Enabled = True
validation.Enabled = False
If aj = 1 Then
Set sq2 = New ADODB.Recordset
sq2.Open "Select s_dept_id.nextval from dual", db, adOpenDynamic,
adLockBatchOptimistic
D(0).Text = sq2.Fields(0) sq2.Close
MAJDept.InsertDept rs2.Close
rs2.Open "Select * from s_dept", db, adOpenDynamic,
adLockBatchOptimistic rs2.MoveLast
D(0).Text = rs2("id") D(1).Text = rs2("Name")
cmbrg.Open "Select * from s_region where id=" &
rs2("region_id"), db,
adOpenDynamic, adLockBatchOptimistic
DRG.Text = cmbrg("name")
cmbrg.Close
End If
D(0).Enabled = False D(1).Enabled = False DRG.Enabled = False
If up = 1 Then
MAJDept.UpdateDept rs2.Close
rs2.Open "Select * from s_dept", db, adOpenDynamic,
adLockBatchOptimistic rs2.MoveFirst
D(0).Text = rs2("id") D(1).Text = rs2("Name")
cmbrg.Open "Select * from s_region where id=" &
rs2("region_id"), db,
adOpenDynamic, adLockBatchOptimistic DRG.Text = cmbrg("name")
cmbrg.Close
End If
102
aj = 0
up = 0
premier.Enabled = True dernier.Enabled = True precedent.Enabled =
True suivant.Enabled = True nouveau.Enabled = True modifier.Enabled = True
supprimer.Enabled = True fermer.Enabled = True Valider.Enabled = False
Annuler.Enabled = False On Error Resume Next
nb.Open "select count(*) from s_emp Where dept_id =" &
D(0).Text & "group
by dept_id", db, adOpenDynamic, adLockBatchOptimistic nb_emp =
""
nb_emp.Text = nb.Fields(0)
nb.Close
If nb_emp = "" Then
nb_emp.Text = 0
End If
End Sub
4-Employé
a-mode conception
b-Module
Sub InsertEmp()
Dim adoCommand As ADODB.Command
Dim adoRecordSet As ADODB.Recordset
On Error GoTo InsertEmp
Set adoCommand = New ADODB.Command
With adoCommand
.CommandType = adCmdText
.ActiveConnection = db
.CommandText = "SELECT * FROM S_Emp"
End With
104
Set adoRecordSet = New ADODB.Recordset
adoRecordSet.Open adoCommand, , adOpenStatic, adLockOptimistic
adoRecordSet.AddNew
adoRecordSet!ID = FRMEmp.E(0).Text
adoRecordSet!Last_Name = FRMEmp.E(1).Text adoRecordSet!First_Name
= FRMEmp.E(2).Text adoRecordSet!UserID = FRMEmp.E(3).Text
adoRecordSet!Start_Date = FRMEmp.E(4).Text adoRecordSet!Comments =
FRMEmp.E(5).Text adoRecordSet!Manager_ID = FRMEmp.E(6).Text adoRecordSet!title
= FRMEmp.title.Text adoRecordSet!DEPT_ID = FRMEmp.dpt
adoRecordSet!Salary = FRMEmp.E(9).Text
adoRecordSet!Commission_PCT = FRMEmp.compct.Text Call adoRecordSet.Update
Set adoRecordSet = Nothing
Set adoCommand = Nothing
Exit Sub
InsertEmp:
MsgBox "Ajout Error Description:" & Err.Description & "",
vbCritical End Sub
Sub DeleteEmp()
Dim adoCommand As ADODB.Command Dim adoRecordSet As
ADODB.Recordset
On Error GoTo DeleteEmp
Set adoCommand = New ADODB.Command
With adoCommand
.CommandType = adCmdText
.ActiveConnection = db
.CommandText = "SELECT * FROM S_Emp"
End With
Set adoRecordSet = New ADODB.Recordset
adoRecordSet.Open adoCommand, , adOpenStatic, adLockOptimistic
Call adoRecordSet.Find("id =" & FRMEmp.E(0).Text)
While Not adoRecordSet.EOF()
adoRecordSet.Delete
adoRecordSet.MoveNext
Call adoRecordSet.Find("id =" & FRMEmp.E(0).Text)
Wend
If adoRecordSet.RecordCount > 0 Then
adoRecordSet.MoveFirst
End If
Call adoRecordSet.Update
Set adoRecordSet = Nothing
Set adoCommand = Nothing
Exit Sub
DeleteEmp:
MsgBox "Supression Error Description:" & Err.Description
& "", vbCritical
End Sub
106
Sub UpdateEmp()
Dim adoCommand As ADODB.Command Dim adoRecordSet As
ADODB.Recordset On Error GoTo UpdateEmp
Set adoCommand = New ADODB.Command With adoCommand
.CommandType = adCmdText
.ActiveConnection = db
.CommandText = "SELECT
ID,LAST_NAME,FIRST_NAME,USERID,START_DATE,COMMENTS,MANAGER_ID
,TITLE,DEPT_ID,SALARY,COMMISSION_PCT FROM S_Emp" End With
Set adoRecordSet = New ADODB.Recordset
adoRecordSet.Open adoCommand, , adOpenStatic, adLockOptimistic
Call adoRecordSet.Find("id =" & FRMEmp.E(0).Text) While Not
adoRecordSet.EOF()
adoRecordSet!Last_Name = FRMEmp.E(1).Text adoRecordSet!First_Name
= FRMEmp.E(2).Text adoRecordSet!UserID = FRMEmp.E(3).Text
adoRecordSet!Start_Date = FRMEmp.E(4).Text adoRecordSet!Comments =
FRMEmp.E(5).Text adoRecordSet!Manager_ID = FRMEmp.E(6).Text adoRecordSet!title
= FRMEmp.title.Text adoRecordSet!DEPT_ID = FRMEmp.dpt
adoRecordSet!Salary = FRMEmp.E(9).Text
adoRecordSet!Commission_PCT = FRMEmp.compct.Text
adoRecordSet.MoveNext
Call adoRecordSet.Find("id =" & FRMEmp.E(0).Text)
Wend
If adoRecordSet.RecordCount > 0 Then
adoRecordSet.MoveFirst
End If
Call adoRecordSet.Update
Set adoRecordSet = Nothing Set adoCommand = Nothing Exit
Sub
UpdateEmp:
MsgBox "Modification Error Description:" & Err.Description
& "", vbCritical
End Sub
c-code
Option Explicit
Dim rs2 As New ADODB.Recordset Dim sq2 As New ADODB.Recordset Dim
nb As New ADODB.Recordset Dim cmbrg As New ADODB.Recordset Dim cmbch As New
ADODB.Recordset Dim tit As New ADODB.Recordset
Dim aj, up As Integer
Public dpt As Integer
108
Private Sub cmbdept_Click()
dpt = cmbdeptnum.List(cmbdept.ListIndex) End Sub
Private Sub date1_Click() Calendar1.Visible = True End Sub
Private Sub fermer_Click()
Me.Hide
Unload Me
End Sub
Private Sub Form_Load()
On Error Resume Next
E(0).Text = "" E(1).Text = "" E(2).Text = "" E(3).Text = ""
E(4).Text = "" E(5).Text = "" E(6).Text = "" title.Text = "" cmbdept.Text =
""
E(9).Text = "" compct.Text = ""
Set cmbrg = New ADODB.Recordset
Set tit = New ADODB.Recordset
Set cmbch = New ADODB.Recordset
Set rs2 = New ADODB.Recordset Set nb = New ADODB.Recordset
rs2.Open "Select * from s_emp", db, adOpenDynamic,
adLockBatchOptimistic rs2.MoveFirst
E(0).Text = rs2("id")
E(1).Text = rs2("last_Name") E(2).Text = rs2("first_name")
E(3).Text = rs2("userid") E(4).Text = rs2("start_date") E(5).Text =
rs2("comments") E(6).Text = rs2("manager_id") title.Text = rs2("title")
cmbrg.Open "Select name from s_dept where id=" &
rs2("dept_id"), db
cmbdept.Text = cmbrg("name") cmbrg.Close
E(9).Text = rs2("salary")
compct.Text = rs2("commission_pct")
parcours.Enabled = True actions.Enabled = True
validation.Enabled = False premier.Enabled = True dernier.Enabled
= True precedent.Enabled = True suivant.Enabled = True
110
nouveau.Enabled = True modifier.Enabled = True supprimer.Enabled
= True fermer.Enabled = True Valider.Enabled = False Annuler.Enabled = False aj
= 0
up = 0
End Sub
Private Sub Form_Unload(Cancel As Integer) rs2.Close
End Sub
Private Sub precedent_Click()
On Error Resume Next
E(0).Text = vbNullString E(1).Text = vbNullString E(2).Text =
vbNullString E(3).Text = vbNullString E(4).Text = vbNullString E(5).Text =
vbNullString E(6).Text = vbNullString title.Text = vbNullString cmbdept.Text =
vbNullString E(9).Text = vbNullString
112
compct.Text = vbNullString
rs2.MovePrevious
E(0).Text = rs2("id")
E(1).Text = rs2("last_Name") E(2).Text = rs2("first_name")
E(3).Text = rs2("userid") E(4).Text = rs2("start_date") E(5).Text =
rs2("comments") E(6).Text = rs2("manager_id") title.Text = rs2("title")
cmbrg.Open "Select name from s_dept where id=" &
rs2("dept_id"), db cmbdept.Text = cmbrg("name")
E(9).Text = rs2("salary") cmbrg.Close
If rs2("commission_pct") <> "" Then
compct.Text = rs2("commission_pct")
Else
compct.Text = ""
End If
If E(0).Text = "" Then
rs2.MoveNext
E(0).Text = rs2("id")
E(1).Text = rs2("last_Name") E(2).Text = rs2("first_name")
E(3).Text = rs2("userid") E(4).Text = rs2("start_date")
E(5).Text = rs2("comments")
E(6).Text = rs2("manager_id")
title.Text = rs2("title")
cmbrg.Open "Select name from s_dept where id=" &
rs2("dept_id"), db cmbdept.Text = cmbrg("name")
cmbrg.Close
E(9).Text = rs2("salary")
If rs2("commission_pct") <> "" Then
compct.Text = rs2("commission_pct")
Else
compct.Text = ""
End If End If End Sub
Private Sub premier_Click() On Error Resume Next
E(0).Text = vbNullString
E(1).Text =
vbNullString
E(2).Text = vbNullString
E(3).Text = vbNullString E(4).Text = vbNullString E(5).Text =
vbNullString E(6).Text = vbNullString title.Text = vbNullString
cmbdept.Text = vbNullString
E(9).Text = vbNullString compct.Text = vbNullString
rs2.MoveFirst
E(0).Text = rs2("id")
E(1).Text = rs2("last_Name") E(2).Text = rs2("first_name")
E(3).Text = rs2("userid") E(4).Text = rs2("start_date") E(5).Text =
rs2("comments") E(6).Text = rs2("manager_id") title.Text = rs2("title")
cmbrg.Open "Select name from s_dept where id=" &
rs2("dept_id"), db cmbdept.Text = cmbrg("name")
cmbrg.Close
E(9).Text = rs2("salary")
If rs2("commission_pct") <> "" Then
compct.Text = rs2("commission_pct")
Else
compct.Text = ""
End If
End Sub
Private Sub suivant_Click() On Error Resume Next
E(0).Text = vbNullString
114
E(1).Text = vbNullString
E(2).Text = vbNullString E(3).Text = vbNullString E(4).Text =
vbNullString E(5).Text = vbNullString E(6).Text = vbNullString title.Text =
vbNullString cmbdept.Text = vbNullString E(9).Text = vbNullString compct.Text =
vbNullString rs2.MoveNext
E(0).Text = rs2("id")
E(1).Text = rs2("last_Name") E(2).Text = rs2("first_name")
E(3).Text = rs2("userid") E(4).Text = rs2("start_date") E(5).Text =
rs2("comments") E(6).Text = rs2("manager_id") title.Text = rs2("title")
cmbrg.Open "Select name from s_dept where id=" &
rs2("dept_id"), db cmbdept.Text = cmbrg("name")
cmbrg.Close
E(9).Text = rs2("salary")
If rs2("commission_pct") <> "" Then
compct.Text = rs2("commission_pct")
Else
compct.Text = "" End If
If E(0).Text = "" Then
rs2.MovePrevious
E(0).Text = rs2("id")
E(1).Text = rs2("last_Name") E(2).Text = rs2("first_name")
E(3).Text = rs2("userid") E(4).Text = rs2("start_date") E(5).Text =
rs2("comments") E(6).Text = rs2("manager_id") title.Text = rs2("title")
cmbrg.Open "Select name from s_dept where id=" &
rs2("dept_id"), db cmbdept.Text = cmbrg("name")
cmbrg.Close
E(9).Text = rs2("salary")
If rs2("commission_pct") <> "" Then
compct.Text = rs2("commission_pct")
Else
compct.Text = ""
End If
End If
End Sub
Private Sub dernier_Click()
116
On Error Resume Next
E(0).Text = vbNullString E(1).Text = vbNullString E(2).Text =
vbNullString E(3).Text = vbNullString E(4).Text = vbNullString E(5).Text =
vbNullString E(6).Text = vbNullString title.Text = vbNullString cmbdept.Text =
vbNullString E(9).Text = vbNullString compct.Text = vbNullString
rs2.MoveLast
E(0).Text = rs2("id")
E(1).Text = rs2("last_Name") E(2).Text = rs2("first_name")
E(3).Text = rs2("userid") E(4).Text = rs2("start_date") E(5).Text =
rs2("comments") E(6).Text = rs2("manager_id") title.Text = rs2("title")
cmbrg.Open "Select name from s_dept where id=" &
rs2("dept_id"), db cmbdept.Text = cmbrg("name")
cmbrg.Close
E(9).Text = rs2("salary")
If rs2("commission_pct") <> "" Then compct.Text =
rs2("commission_pct") Else
compct.Text = ""
End If
End Sub
Private Sub supprimer_Click()
MAJEmp.DeleteEmp
E(0).Text = "" E(1).Text = "" E(2).Text = "" E(3).Text = ""
E(4).Text = "" E(5).Text = "" E(6).Text = "" title.Text = "" cmbdept.Text =
""
E(9).Text = "" compct.Text = ""
On Error Resume Next
rs2.Close
rs2.Open "Select * from s_Emp", db, adOpenDynamic,
adLockBatchOptimistic rs2.MoveFirst
E(0).Text = rs2("id")
E(1).Text = rs2("last_Name")
118
E(2).Text = rs2("first_name")
E(3).Text = rs2("userid")
E(4).Text = rs2("start_date")
E(5).Text = rs2("comments")
E(6).Text = rs2("manager_id")
title.Text = rs2("title")
cmbrg.Open "Select name from s_dept where id=" &
rs2("dept_id"), db cmbdept.Text = cmbrg("name")
cmbrg.Close
E(9).Text = rs2("salary")
compct.Text = rs2("commission_pct")
End Sub
Private Sub nouveau_Click()
parcours.Enabled = False
actions.Enabled = False validation.Enabled = True
E(0).Enabled = False E(1).Enabled = True E(2).Enabled = True
E(3).Enabled = True E(4).Enabled = True E(5).Enabled = True E(6).Enabled = True
title.Enabled = True cmbdept.Enabled = True
E(9).Enabled = True compct.Enabled = True date1.Enabled = True
E(0).Text = ""
E(1).Text = "" E(2).Text = "" E(3).Text = "" E(4).Text = ""
E(5).Text = "" E(6).Text = "" title.Text = "" cmbdept.Text = "" E(9).Text = ""
compct.Text = "10"
aj = 1
up = 0
premier.Enabled = False dernier.Enabled = False precedent.Enabled
= False suivant.Enabled = False nouveau.Enabled = False modifier.Enabled =
False supprimer.Enabled = False fermer.Enabled = False Valider.Enabled = True
Annuler.Enabled = True
120
E(0).Text = "Identifiant Automatique"
cmbch.Open "Select * from s_dept", db, adOpenDynamic,
adLockBatchOptimistic
While Not cmbch.EOF()
cmbdept.AddItem (cmbch("name")) cmbdeptnum.AddItem
(cmbch("id")) cmbch.MoveNext
Wend
cmbch.Close
tit.Open "Select * from s_title", db, adOpenDynamic,
adLockBatchOptimistic While Not tit.EOF()
title.AddItem (tit("title"))
tit.MoveNext
Wend tit.Close End Sub
Private Sub modifier_Click()
parcours.Enabled = False
actions.Enabled = False validation.Enabled = True
E(0).Enabled = False E(1).Enabled = True E(2).Enabled = True
E(3).Enabled = True
E(4).Enabled = True E(5).Enabled = True E(6).Enabled = True
title.Enabled = True cmbdept.Enabled = True E(9).Enabled = True compct.Enabled
= True date1.Enabled = True
compct.Text = rs2("commission_pct")
aj = 0
up = 1
premier.Enabled = False dernier.Enabled = False
precedent.Enabled = False
suivant.Enabled = False nouveau.Enabled = False
modifier.Enabled = False
supprimer.Enabled = False
fermer.Enabled = False Valider.Enabled = True Annuler.Enabled
= True cmbch.Open "Select * from s_dept", db, adOpenDynamic,
adLockBatchOptimistic
While Not cmbch.EOF()
cmbdept.AddItem (cmbch("name")) cmbdeptnum.AddItem
(cmbch("id"))
122
cmbch.MoveNext Wend
cmbch.Close
tit.Open "Select * from s_title", db, adOpenDynamic,
adLockBatchOptimistic
While Not tit.EOF()
title.AddItem (tit("title"))
tit.MoveNext
Wend tit.Close End Sub
Private Sub Annuler_Click() cmbdept.Clear
cmbdeptnum.Clear
title.Clear
parcours.Enabled = True actions.Enabled = True validation.Enabled
= False premier.Enabled = True dernier.Enabled = True precedent.Enabled = True
suivant.Enabled = True
nouveau.Enabled = True modifier.Enabled = True supprimer.Enabled
= True fermer.Enabled = True Valider.Enabled = False Annuler.Enabled = False
E(0).Enabled = False E(1).Enabled = False E(2).Enabled = False E(3).Enabled =
False E(4).Enabled = False E(5).Enabled = False E(6).Enabled = False
title.Enabled = False cmbdept.Enabled = False E(9).Enabled = False
compct.Enabled = False date1.Enabled = False Calendar1.Visible = False
E(0).Text = ""
E(1).Text = ""
E(2).Text = ""
E(3).Text = ""
E(4).Text = ""
E(5).Text = ""
E(6).Text = ""
124
title.Text = ""
cmbdept.Text = ""
E(9).Text = ""
compct.Text = ""
On Error Resume Next
rs2.Close
rs2.Open "Select * from s_Emp", db, adOpenDynamic,
adLockBatchOptimistic rs2.MoveFirst
E(0).Text = rs2("id")
E(1).Text = rs2("last_Name") E(2).Text = rs2("first_name")
E(3).Text = rs2("userid") E(4).Text = rs2("start_date") E(5).Text =
rs2("comments") E(6).Text = rs2("manager_id") title.Text = rs2("title")
cmbrg.Open "Select name from s_dept where id=" &
rs2("dept_id"), db cmbdept.Text = cmbrg("name")
cmbrg.Close
E(9).Text = rs2("salary")
compct.Text = rs2("commission_pct")
aj = 0
up = 0
End Sub
Private Sub Valider_Click()
cmbdept.Clear
cmbdeptnum.Clear
parcours.Enabled = True
actions.Enabled = True
validation.Enabled = False
If aj = 1 Then
Set sq2 = New ADODB.Recordset
sq2.Open "Select s_emp_id.nextval from dual", db,
adOpenDynamic,
adLockBatchOptimistic
E(0).Text = sq2.Fields(0)
sq2.Close
MAJEmp.InsertEmp
title.Clear
E(0).Text = "" E(1).Text = "" E(2).Text = "" E(3).Text = ""
E(4).Text = "" E(5).Text = "" E(6).Text = "" title.Text = "" cmbdept.Text =
""
E(9).Text = "" compct.Text = ""
126
On Error Resume Next rs2.Close
rs2.Open "Select * from s_Emp", db, adOpenDynamic,
adLockBatchOptimistic rs2.MoveLast
E(0).Text = rs2("id") E(1).Text = rs2("last_Name")
E(2).Text = rs2("first_name")
E(3).Text = rs2("userid") E(4).Text = rs2("start_date")
E(5).Text = rs2("comments")
E(6).Text = rs2("manager_id")
title.Text = rs2("title")
cmbrg.Open "Select name from s_dept where id=" &
rs2("dept_id"), db
cmbdept.Text = cmbrg("name")
cmbrg.Close
E(9).Text = rs2("salary")
compct.Text = rs2("commission_pct")
End If
E(0).Enabled = False E(1).Enabled = False E(2).Enabled = False
E(3).Enabled = False E(4).Enabled = False E(5).Enabled = False E(6).Enabled =
False title.Enabled = False
cmbdept.Enabled = False
E(9).Enabled = False
compct.Enabled = False
date1.Enabled = False
Calendar1.Visible = False
If up = 1 Then MAJEmp.UpdateEmp
title.Clear
E(0).Text = "" E(1).Text = "" E(2).Text = "" E(3).Text = ""
E(4).Text = "" E(5).Text = "" E(6).Text = "" title.Text = "" cmbdept.Text =
""
E(9).Text = "" compct.Text = ""
On Error Resume Next
rs2.Close
rs2.Open "Select * from s_Emp", db, adOpenDynamic,
adLockBatchOptimistic rs2.MoveLast
E(0).Text = rs2("id")
E(1).Text = rs2("last_Name")
E(2).Text = rs2("first_name")
128
E(3).Text = rs2("userid") E(4).Text = rs2("start_date") E(5).Text
= rs2("comments") E(6).Text = rs2("manager_id") title.Text = rs2("title")
cmbrg.Open "Select name from s_dept where id=" &
rs2("dept_id"), db cmbdept.Text = cmbrg("name")
cmbrg.Close
E(9).Text = rs2("salary")
compct.Text = rs2("commission_pct")
End If
aj = 0
up = 0
premier.Enabled = True dernier.Enabled = True precedent.Enabled =
True suivant.Enabled = True nouveau.Enabled = True modifier.Enabled = True
supprimer.Enabled = True fermer.Enabled = True Valider.Enabled = False
Annuler.Enabled = False End Sub
Private Sub Calendar1_Click() E(4).Text = Calendar1.Value
Calendar1.Visible = False End Sub
5-Client
6-Région
a-mode de conception
130
b-Module
Sub InsertRégion()
Dim adoCommand As ADODB.Command
Dim adoRecordSet As ADODB.Recordset
On Error GoTo InsertRégion
Set adoCommand = New ADODB.Command
With adoCommand
.CommandType = adCmdText
.ActiveConnection = db
.CommandText = "SELECT ID,NAME FROM S_REGION" End With
Set adoRecordSet = New ADODB.Recordset
adoRecordSet.Open adoCommand, , adOpenStatic,
adLockOptimistic
adoRecordSet.AddNew
adoRecordSet!ID = FRMRégion.R(0).Text
adoRecordSet!Name = FRMRégion.R(1).Text
Call adoRecordSet.Update Set adoRecordSet = Nothing Set
adoCommand = Nothing Exit Sub
InsertRégion:
MsgBox "Ajout Error Description:" & Err.Description & "",
vbCritical End Sub
Sub DeleteRégion()
Dim adoCommand As ADODB.Command
Dim adoRecordSet As ADODB.Recordset
On Error GoTo DeleteRégion
Set adoCommand = New ADODB.Command
With adoCommand
.CommandType = adCmdText
.ActiveConnection = db
.CommandText = "SELECT ID,NAME FROM S_REGION" End With
Set adoRecordSet = New ADODB.Recordset
adoRecordSet.Open adoCommand, , adOpenStatic, adLockOptimistic
Call adoRecordSet.Find("id =" & FRMRégion.R(0).Text)
While Not adoRecordSet.EOF() adoRecordSet.Delete
adoRecordSet.MoveNext
Call adoRecordSet.Find("id =" &
FRMRégion.R(0).Text)
Wend
If adoRecordSet.RecordCount > 0 Then
adoRecordSet.MoveFirst End If
Call adoRecordSet.Update Set adoRecordSet = Nothing Set
adoCommand = Nothing Exit Sub
132
DeleteRégion:
MsgBox "Supression Error Description:" & Err.Description
& "", vbCritical End Sub
Sub UpdateRégion()
Dim adoCommand As ADODB.Command
Dim adoRecordSet As ADODB.Recordset
On Error GoTo UpdateRégion
Set adoCommand = New ADODB.Command
With adoCommand
.CommandType = adCmdText
.ActiveConnection = db
.CommandText = "SELECT ID,NAME FROM S_REGION" End With
Set adoRecordSet = New ADODB.Recordset
adoRecordSet.Open adoCommand, , adOpenStatic, adLockOptimistic
Call adoRecordSet.Find("id =" & FRMRégion.R(0).Text)
While Not adoRecordSet.EOF()
adoRecordSet!Name = FRMRégion.R(1).Text
adoRecordSet.MoveNext
Call adoRecordSet.Find("id =" & FRMRégion.R(0).Text)
Wend
If adoRecordSet.RecordCount > 0 Then adoRecordSet.MoveFirst
End If
Call adoRecordSet.Update
Set adoRecordSet = Nothing Set adoCommand = Nothing Exit
Sub
UpdateRégion:
MsgBox "Modification Error Description:" & Err.Description
& "", vbCritical End Sub
c-Code
Option Explicit
Dim rs As New ADODB.Recordset Dim sq As New ADODB.Recordset
Dim aj, up As Integer
Private Sub Annuler_Click() parcours.Enabled = True
actions.Enabled = True validation.Enabled = False premier.Enabled = True
dernier.Enabled = True precedent.Enabled = True
134
suivant.Enabled = True nouveau.Enabled = True modifier.Enabled =
True supprimer.Enabled = True fermer.Enabled = True Valider.Enabled = False
Annuler.Enabled = False R(0).Enabled = False R(1).Enabled = False
rs.MoveFirst
R(0).Text = rs("id") R(1).Text = rs("Name") aj = 0
up = 0
End Sub
Private Sub fermer_Click() Me.Hide
Unload Me
End Sub
Private Sub Form_Load() Dim i As Integer
For i = 0 To 1
R(i) = 0
Next
Set rs = New ADODB.Recordset
rs.Open "Select * from s_region", db, adOpenDynamic,
adLockBatchOptimistic rs.MoveFirst
R(0).Text = rs("id")
R(1).Text = rs("Name")
parcours.Enabled = True
actions.Enabled = True
validation.Enabled = False
premier.Enabled = True dernier.Enabled = True precedent.Enabled =
True suivant.Enabled = True nouveau.Enabled = True modifier.Enabled = True
supprimer.Enabled = True fermer.Enabled = True Valider.Enabled = False
Annuler.Enabled = False aj = 0
up = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
rs.Close
End Sub
136
Private Sub modifier_Click() parcours.Enabled = False
actions.Enabled = False validation.Enabled = True R(0).Enabled = False
R(1).Enabled = True
aj = 0
up = 1
premier.Enabled = False dernier.Enabled = False precedent.Enabled
= False suivant.Enabled = False nouveau.Enabled = False modifier.Enabled =
False supprimer.Enabled = False fermer.Enabled = False Valider.Enabled = True
Annuler.Enabled = True End Sub
Private Sub nouveau_Click() parcours.Enabled = False
actions.Enabled = False validation.Enabled = True R(0).Enabled = False
R(1).Enabled = True
R(0).Text = ""
R(1).Text = ""
aj = 1
up = 0
premier.Enabled = False dernier.Enabled = False precedent.Enabled
= False suivant.Enabled = False nouveau.Enabled = False modifier.Enabled =
False supprimer.Enabled = False fermer.Enabled = False Valider.Enabled = True
Annuler.Enabled = True
R(0).Text = "Identifiant Automatique" End Sub
Private Sub precedent_Click()
On Error Resume Next
R(0).Text = "" R(1).Text = "" rs.MovePrevious
R(0).Text = rs("id")
R(1).Text = rs("Name")
If R(0).Text = "" Then
138
rs.MoveNext
R(0).Text = rs("id") R(1).Text = rs("Name") End If
End Sub
Private Sub premier_Click() On Error Resume Next rs.MoveFirst
R(0).Text = rs("id") R(1).Text = rs("Name") End Sub
Private Sub suivant_Click() On Error Resume Next R(0).Text =
""
R(1).Text = ""
rs.MoveNext
R(0).Text = rs("id") R(1).Text = rs("Name") If R(0).Text = ""
Then rs.MovePrevious
R(0).Text = rs("id") R(1).Text = rs("Name") End If
End Sub
Private Sub dernier_Click() On Error Resume Next
rs.MoveLast
R(0).Text = rs("id")
R(1).Text = rs("Name")
End Sub
Private Sub supprimer_Click()
MAJRégion.DeleteRégion
rs.Close
rs.Open "Select * from s_region", db, adOpenDynamic,
adLockBatchOptimistic rs.MoveFirst
R(0).Text = rs("id")
R(1).Text = rs("Name")
End Sub
Private Sub Valider_Click()
parcours.Enabled = True
actions.Enabled = True
validation.Enabled = False
If aj = 1 Then
Set sq = New ADODB.Recordset
sq.Open "Select s_region_id.nextval from dual", db,
adOpenDynamic,
adLockBatchOptimistic
R(0).Text =
sq.Fields(0)
sq.Close
140
MAJRégion.InsertRégion rs.Close
rs.Open "Select * from s_region", db, adOpenDynamic,
adLockBatchOptimistic rs.MoveLast
R(0).Text = rs("id")
R(1).Text = rs("Name") End If
R(0).Enabled = False R(1).Enabled = False If up = 1 Then
MAJRégion.UpdateRégion rs.Close
rs.Open "Select * from s_region", db, adOpenDynamic,
adLockBatchOptimistic rs.MoveFirst
R(0).Text = rs("id")
R(1).Text = rs("Name") End If
aj = 0
up = 0
premier.Enabled = True dernier.Enabled = True precedent.Enabled =
True suivant.Enabled = True nouveau.Enabled = True modifier.Enabled = True
supprimer.Enabled = True
fermer.Enabled = True Valider.Enabled = False Annuler.Enabled
= False End Sub
142
| 
