Discussion :

[olivierdenantes]

Bonjour,
Pas assez de connaissance VBA, je rame dur…

- Table « Resa » avec NumResa (NumAuto)
- Formulaire « Resa1 » pour ouvrir sur une période de l’année via une liste déroulante
- Sous Formulaire « Resa2 » pour inscrire une personne sur la réservation (Table Resa)

Fonctionnement en multi-utilisateur,

- je souhaite que lorsque l’utilisateur 1 ouvre le sous-formulaire via le « NumResa » pour inscrire ou modifier les champs
- et que les autres utilisateurs ne puissent pas ouvrir le sous formulaire sur le même « NumResa » avec message « Saisie en cours »
Les autres utilisateurs peuvent ouvrir le sous formulaire sur un autre « NumResa » mais pas celui déjà utilisé par utilisateur 1

J’ai essayé plusieurs idées trouvées sur le forum dont celle de Loufab, sans aboutir

Je travaille sous access 2013

D’avance merci si quelqu’un a un peu de lumière
Olivier

[marot_r]

Bojnour.

Il va falloir mettre en place un mecanisme de "semaphore" :

1. Quand quelqu'un veut "entrer en modification" il verifie si le semaphore est leve.
2. Si il n'est pas leve, il le leve et entre en modification.
   Sinon il ne peut pas entrer en modification.
3. Il fait ses modifications.
4. Il baisse le semaphore pour signaler qu'il a fini.

c'est assez simple a mettre en oeuvre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
public function DemanderModif() as Boolean
  dim result as Boolean:result=false
  on error goto Err_DemanderModif
 
  dim db as dao.database: set db=currentdb
  dim r as dao.recordset:set r=db.openrecordset("tblSemaphore", dbOpenDynaset)
 
  if Not r![EstEnModif] then
    r.edit
    r![CodeUtilisateur]=Environ$("UserName")
    r![EstEnModif]=true
    r.update
  end if
 
  r.close: set r=nothing
  db.close: set db=nothing
 
exit_DemanderModif:
  DemanderModif=result
  exit function
 
Err_emanderModif:
  select case err.number
      case X 'Enregistrement verrouille (je ne me souviens plus du numero de l'erreur)
         resume exit_DemanderModif
      case else
         call err.raise(err.number,,err.description)
  end select
 
end function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
public sub LibererModif()
  on error goto Err_DemanderModif
 
  dim db as dao.database: set db=currentdb
  dim r as dao.recordset:set r=db.openrecordset("tblSemaphore", dbOpenDynaset)
 
  r.edit
  r![CodeUtilisateur]=Null
  r![EstEnModif]=false
  r.update
 
  r.close: set r=nothing
  db.close: set db=nothing
end function

Utilisation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
if DemanderModif() then
     msgbox "Modif autorisee"
     'ici la modif
     call LibererModif
   else
     msgbox "Modif refusee"
end if

Evidement il faut aussi prevoir un mecanisme pour baisser le semaphore au cas ou quelqu'un serait sorti de la modification SANS baisser le semaphore. Sinon tout le monde va etre bloque ad vitam eternam.

Sas-tu que si tu utilises le verrouillage par enregistrement Access bloque l'acces a un enregistrement en cours de modification ?
Si tu as conservesl'affichage du selecteur d'enregistrement (le carre gris a gauche) il affiche un signe d'interdiction en forme de 0 barre.

Le point delicat va etre de detecter que quelqu'un veut "entrer" en modification.
Est-ce que tu as une action qui precede la modif (ex : appuye sur un bouton "Modif") ?

A+

[olivierdenantes]

Merci Marot r !!
je prends le temps de tout comprendre et de créer

Merci pour le côté "assez simple" )

A suivre et encore merci

[olivierdenantes]

Re-Bonjour,
Très difficile pour moi, je sais qu’une formation VBA s’impose, malheureusement le temps manque

Je dois créer une table « tblSemaphore » et une table « utilisateurs »

Ok pour la 2ème, numAuto + nom utilisateur
Pour « tblSemaphore » que doit elle contenir ?

J’avais testé le verrouillage Access mais pas suffisant selon l’ordre d’ouverture et fermeture entre les utilisateurs.

Merci pour ta réponse

[marot_r]

Bonjour.

Je m'appercois que mon code est bugge, je l'ai corrige dans le post et inadapte a ton probleme.

Je suppose que tu as une table tblReservation.
Il fau lui ajouter 2 champs :

• CodeUtilisateurModif (texte 255, le code de connexion a Windows)
• EstEnModif (Oui/Non, valuer defaut non)

et le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
public function DemanderModif(prmNumResa as long) as Boolean
  dim result as Boolean:result=false
  on error goto Err_DemanderModif
 
  dim db as dao.database: set db=currentdb
  dim r as dao.recordset:set r=db.openrecordset("tblReservation", dbOpenDynaset)
 
  call r.findfirst("[CodeResa]=" & prmCodeRsea)
 
  if not r![EstEnModif] then
     r.edit
     r![CodeUtilisateur]=Environ$("UserName")
     r![EstEnModif]=true
     r.update
     result=true
  end if
 
  r.close: set r=nothing
  db.close: set db=nothing
 
exit_DemanderModif:
  DemanderModif=result
  exit function
 
Err_emanderModif:
  select case err.number
      case X 'Enregistrement verrouille (je ne me souviens plus du numero de l'erreur)
         resume exit_DemanderModif
      case else
         call err.raise(err.number, , err.description)
  end select
 
end function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
public sub LibererModif(prmNumResa as long)
  dim db as dao.database: set db=currentdb
  dim r as dao.recordset:set r=db.openrecordset("tblReservation", dbOpenDynaset)
 
  call r.findfirst("[CodeResa]=" & prmCodeRsea)
 
  r.edit
  r![CodeUtilisateur]=Null
  r![EstEnModif]=false
  r.update
  result=true
 
  r.close: set r=nothing
  db.close: set db=nothing
end function

utilisation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
if DemanderModif(IciCodeResa) then
     msgbox "Modif autorisee"
     'ici la modif
     call LibererModif
   else
     msgbox "Modif refusee"
end if

A+

[olivierdenantes]

Ok j'ai adapté

J'ai une erreur au 3ème code sur Call LibererModif

j'ai mis cette condition sur ouverture de mon formulaire

[marot_r]

Peux-tu poster ton code et indiquer ou est l'erreur et quelle erreur ?

A+

[olivierdenantes]

Bonjour Marot r

Message erreur : Erreur de compilation
Argument non facultatif (j'ai cherché le n°, erreur 449)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub Form_Open(Cancel As Integer)
If DemanderModif(NumResa) Then
     MsgBox "Modif autorisee"
 
    Call LibererModif
 
   Else
     MsgBox "Modif refusee"
End If
End Sub

[marot_r]

Bonjour.

La fonction LibererModif(prmNumResa as long) attend un parametre et je l'ai oublie.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Call LibererModif(numresa)

A+

[olivierdenantes]

ok merci
étrange pour moi d'avancer sans tout comprendre

cet ajout fait avancer sur autre bug

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Public Function DemanderModif(prmNumResa As Long) As Boolean
  Dim result As Boolean: result = False
  On Error GoTo Err_DemanderModif
 
  Dim db As DAO.Database: Set db = CurrentDb
  Dim r As DAO.Recordset: Set r = db.OpenRecordset("TResaLit2", dbOpenDynaset)
 
  Call r.FindFirst("[NumResa]=" & prmNumResa)
 
  If Not r![EstEnModif] Then
     r.Edit
     r![CodeUtilisateur] = Environ$("UserName")
     r![EstEnModif] = True
     r.Update
     result = True
  End If
 
  r.Close: Set r = Nothing
  db.Close: Set db = Nothing
 
exit_DemanderModif:
  DemanderModif = result
  Exit Function
 
Err_DemanderModif:
  Select Case Err.Number
      Case X 'Enregistrement verrouille (je ne me souviens plus du numero de l'erreur)
         Resume exit_DemanderModif
      Case Else
         Call Err.Raise(Err.Number, , Err.Description)  CETTE LIGNE EST EN JAUNE
  End Select
 
End Function

Après quelques recherches, je trouve les numéros d'erreur pour enregistrement suivant, précédent, etc, ...
Pas pour enregistrement verrouillé

D'avance merci

[marot_r]

Bonjour.

Ce n'est pas un bug a priori, quelle est l'erreur retournee par Access ?

A+

[olivierdenantes]

Erreur d'exécution 3265 :
element non trouvé dans cette collection

[marot_r]

OK, desactive momentanement la gestion d'erreur en mettant la ligne en commentaire.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

'On Error GoTo Err_DemanderModif

Rexecute et Access va s'arreter sur la ligne qui lui pose vraiment un probleme.

A+

[olivierdenantes]

Bonjour Marot_r

Merci pour ton suivi

J'ai ajouté code comme ci dessous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Public Function DemanderModif(prmNumResa As Long) As Boolean
  Dim result As Boolean: result = False
  On Error GoTo Err_DemanderModif
 
  Dim db As DAO.Database: Set db = CurrentDb
  Dim r As DAO.Recordset: Set r = db.OpenRecordset("TResaLit2", dbOpenDynaset)
 
  Call r.FindFirst("[NumResa]=" & prmNumResa)
 
  If Not r![EstEnModif] Then
     r.Edit
     r![CodeUtilisateur] = Environ$("UserName")
     r![EstEnModif] = True
     r.Update
     result = True
  End If
 
  r.Close: Set r = Nothing
  db.Close: Set db = Nothing
 
exit_DemanderModif:
  DemanderModif = result
  Exit Function
 
Err_DemanderModif:
On Error GoTo Err_DemanderModif

  Select Case Err.Number
      Case X 'Enregistrement verrouille (je ne me souviens plus du numero de l'erreur)
         Resume exit_DemanderModif
      Case Else
         Call Err.Raise(Err.Number, , Err.Description)
  End Select
  
 
End Function

- Plus d'erreur,
- msgbox "modif refusée" affichée,
- le formulaire s'ouvre et est opérationnel

1 seul utilisateur connecté donc le msgbox doit etre "modif acceptée"
Après quelques changements qui n'aboutissent pas, j'ai tout remis en ordre.

Merci pour ton suivi

[olivierdenantes]

Bonjour Marot_r

j'ai modifié comme ci dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Public Function DemanderModif(prmNumResa As Long) As Boolean
  Dim result As Boolean: result = False
  On Error GoTo Err_DemanderModif
 
  Dim db As DAO.Database: Set db = CurrentDb
  Dim r As DAO.Recordset: Set r = db.OpenRecordset("TResaLit2", dbOpenDynaset)
 
  Call r.FindFirst("[NumResa]=" & prmNumResa)
 
  If Not r![EstEnModif] Then
     r.Edit
     r![CodeUtilisateurModif] = Environ$("UserName")
     r![EstEnModif] = True
     r.Update
     result = True
  End If
 
  r.Close: Set r = Nothing
  db.Close: Set db = Nothing
 
exit_DemanderModif:
  DemanderModif = result
  Exit Function
 
Err_DemanderModif:
  Select Case Err.Number
      Case X 'Enregistrement verrouille (je ne me souviens plus du numero de l'erreur)
         Resume exit_DemanderModif
      Case Else
      Call LibererModif(NumResa)
         Call Err.Raise(Err.Number, , Err.Description)
  End Select
 
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Public Sub LibererModif(prmNumResa As Long)
  Dim db As DAO.Database: Set db = CurrentDb
  Dim r As DAO.Recordset: Set r = db.OpenRecordset("TResaLit2", dbOpenDynaset)
 
    Call r.FindFirst("[NumResa]=" & prmNumResa)
 
  r.Edit
  r![CodeUtilisateurModif] = Null
  r![EstEnModif] = False
  r.Update
  result = True
 
  r.Close: Set r = Nothing
  db.Close: Set db = Nothing
 
End Sub

A l'ouverture de mon formulaire de réservation, j'ai bien le msgbox "dispo" puis accès au modification.
Si connecté à 2 utilisateurs simultanément, les 2 ont msgbox "dispo" et accès aux modifications.

Dans ma table j'ai ajouté le champs "CodeUtilisateurModif" sans comprendre son usage

D'avance merci

[marot_r]

Bonjour.

Le champ CodeUtilisateurModif te permet de savoir qui demande actuellement la modification.
Il n'est pas indispensable mais pratique quand tu voudras savoir "Pourquoi je n'ai pas acces ? Qui est-ce qui bloque ?".

Le programme que je t'ai ecrit n'est pas suffisant pour verrouiller.
Il faut que tu mettes du code dans ton formulaire pour empecher la personne d'acceder.

Un truc du genre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
if not DemanderModif(me.NumResa) then
    msgbox "Actuellement en modification"
 else
   me.SousFormResa.AllowEdit=true
end if

A+

[olivierdenantes]

j'avance !!

J'utilise le champs "chkEstEnModif"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Sur ouverture du Form_TresaLit1, j'ai mis le code :
Me.ChkEstEnModif = True

je fais le verrouillage sur chk = True

mais je n'arrive pas à décocher la chk sur fermeture du Form_TresaLit1
j'ai essayé : Me.ChkEstEnModif = False mais non non non
je parcours la FAQ à la recherche d'un pas de plus en avant.

POURQUOI sur fermeture la chk reste True !!

[marot_r]

Bonjour.

Ou appeles-tu le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Me.ChkEstEnModif = False

Dans l'evenement "sur fermeture" de Form_TresaLit1 ?

A+

[olivierdenantes]

oui
avec un autre code aussi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub Form_Close()
Me.ChkEstEnModif = False
Form_302000SfRTresaLitNom.Requery
End Sub

[marot_r]

Bonjour.

Hum, a priori c'est le bon code au bon endroit.

As-tu suvi ton code pas a pas et verifier ce que valait ChkEstEnModif ?

1. Pour faire cela, se mettre dans le code puis cliquer dans la marge a gauche en face de Private Sub Form_Close.
   Cela va afficher un gros point marron (le point d'arret).
2. Sauvegarder.
3. Afficher le formulaire et declencher l'evenement.
4. Access va passer en mode debugage sur l'instruction pointee.
5. Pour voir la valeur d'une variable, juste pointer avec la souris.
6. Pour passer a l'instruction suivante, appuyer sur la touche [f8].
   Pour relancer l'execution normale, appuyer sur [F5].

Est-ce que ChkEstEnModif est un champ lie (il est dans la source de donnees et est donc conserve) ou independent (il est seulement dans le formulaire et perdu a la fermeture).

A+