Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Access provoquer un évènement depuis autre formulaire

provoquer un évènement depuis autre formulaire

6 réponses
Avatar
sonia.gaubert
Bonjour,
Mon dernier message ne rencontre pas beaucoup de succ=E8s : celui-ci en
aura t'il plus ?
J'aimerais savoir s'il est possible de provoquer l'=E9v=E8nement
afterupdate d'un champ depuis un autre formulaire (en l'ouvrant avant
bien s=FBr, par docmd.open...) ?
Merci par avance,
Sonia.
Signaler un problème avec ce contenu

6 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Le Méruvien
bonjour sonia, oui tu peut tres bien mettre a jour ton champ a partir d'un
autre formulaire!
Tou simplement en lançant une requette de mise a jour a partir de ton form
ouvert!
roger

--
Site: http://lemeruvien.jimdo.com/
Blog: http://le-meruvien.skynetblogs.be/
a écrit dans le message de news:

Bonjour,
Mon dernier message ne rencontre pas beaucoup de succès : celui-ci en
aura t'il plus ?
J'aimerais savoir s'il est possible de provoquer l'évènement
afterupdate d'un champ depuis un autre formulaire (en l'ouvrant avant
bien sûr, par docmd.open...) ?
Merci par avance,
Sonia.
Avatar
sonia.gaubert
Bonjour et merci pour ta réponse Roger :o)
... mais je crois que je me suis mal expliquée : je ne veux pas mettre
à jour simplement le champ en question...,
je veux très précisément : sur l'évènement mise à jour d'un cha mp
donné dans formulaire1 (si modification), ouvrir formulaire2 et
provoquer l'évènement mise à jour d'un des champs de ce formulaire (o ù
j'ai associée une Sub qui fait une série de contrôles et modification
sur et à partir des champs de formulaire2.
J'ai pensé à cette solution parce que j''ai la flemme de réécrire
intégralement la Sub en question (très longue) et la coller à
l'évènement after maj du champ de formulaire1... j'ai essayé de la
déclarer public mais cela ne fonctionne pas depuis mon formulaire1 (je
ne maitrise pas trop la manipulation des sub et procédures... )
Je pensais qu'il y avait une solution simple pour déclencher un
évènement lié à un champ mais ?
hmm ?
Sonia.




On 6 juin, 06:30, "Le Méruvien" wrote:
bonjour sonia, oui tu peut tres bien mettre a jour ton champ a partir d'u n
autre formulaire!
Tou simplement en lançant une requette de mise a jour a partir de ton f orm
ouvert!
roger

--
Site:http://lemeruvien.jimdo.com/
Blog:http://le-meruvien.skynetblogs.be/
a écrit dans le message de news:

Bonjour,
Mon dernier message ne rencontre pas beaucoup de succès : celui-ci en
aura t'il plus ?
J'aimerais savoir s'il est possible de provoquer l'évènement
afterupdate d'un champ depuis un autre formulaire (en l'ouvrant avant
bien sûr, par docmd.open...) ?
Merci par avance,
Sonia.


Avatar
Michel__D
Bonjour,

a écrit :
Bonjour et merci pour ta réponse Roger :o)
.... mais je crois que je me suis mal expliquée : je ne veux pas mettre
à jour simplement le champ en question...,
je veux très précisément : sur l'évènement mise à jour d'un champ
donné dans formulaire1 (si modification), ouvrir formulaire2 et
provoquer l'évènement mise à jour d'un des champs de ce formulaire (où
j'ai associée une Sub qui fait une série de contrôles et modification
sur et à partir des champs de formulaire2.
J'ai pensé à cette solution parce que j''ai la flemme de réécrire
intégralement la Sub en question (très longue) et la coller à
l'évènement after maj du champ de formulaire1... j'ai essayé de la
déclarer public mais cela ne fonctionne pas depuis mon formulaire1 (je
ne maitrise pas trop la manipulation des sub et procédures... )
Je pensais qu'il y avait une solution simple pour déclencher un
évènement lié à un champ mais ?
hmm ?
Sonia.



Place ta Sub dans un module et tu pourras l'appeler de n'importe quelle
procédure évementielle, par contre tu perds l'identification implicite
des contrôles (Me.???) au niveau de ta Sub, mais c'est tout de même la
solution à privilégier.
Avatar
sonia.gaubert
Bonjour Michel et merci pour ce conseil, que je supposes être fort
bon ;o)
Mais je veux bien être un peu "accompagnée" sur ce coup là...
Suffit-il que, une fois recopiée ma sub dans un module, je remplace
chaque référence à Me. par le nom de mon formulaire ou bien quelque
chose d'encore plus "neutre" (et si oui comment l'écrire : Form. ?)
Je supposes qu'à l'appel de ma procédure c'est le nom du formulaire
que je devrais préciser (genre VerifRef(NomForm) ?
Un peu paumée... Ci-dessous je recopie ma - très fastidieuse - sub (du
travail d'amateur : surement moyen de simplifier...mais fonctionne !)
Par avance encore merci,
Sonia.

'Déclarations messages
Dim msg, Style, Title, Response, MyString
Dim nbr As Integer
'Déclaration d'objets pour création
Dim RepObjet As Folder
Dim fso As New FileSystemObject
'déclaration pour call shell
Dim stAppName As String
'déclarations répertoires
Dim NomRepFonds As String
NomRepFonds = "I:" & Me![Abreviation]
Dim NomRepObjet As String
'Déclarations pour renommage
Dim db As Database
Dim strSQL As String
Dim rst As Recordset
Dim strSQL1 As String
strSQL1 = "SELECT ReqDocumentsListe.* FROM ReqDocumentsListe WHERE
ReqDocumentsListe.RefDoc =" & Me.RefDoc
Dim AncNomRepProj As String
Dim NouvNomRepProj As String
Dim MAJRefObjet As String
Dim OldName, NewName
OldName = "I:" & Me![Abreviation] & "" & AncNomRepProj
NewName = "I:" & Me![Abreviation] & "" & NouvNomRepProj

If Not IsNull(Me![RefobjDoc]) Or Me![RefobjDoc] <> "" Then
MAJRefObjet = Me![RefobjDoc]
AncNomRepProj = Me![AutreRefProjet]
NouvNomRepProj = Me![RefobjDoc].Column(1)
OldName = "I:" & Me![Abreviation] & "" & AncNomRepProj
NewName = "I:" & Me![Abreviation] & "" & NouvNomRepProj
Me![AutreRefProjet] = Me![RefobjDoc].Column(1)
If AncNomRepProj <> NouvNomRepProj Then
strSQL = "SELECT Documents.* FROM Documents WHERE
Documents.AutreRefProjet = """ & AncNomRepProj & """"
strSQL = strSQL & "AND (Documents.RefFonds) =" & Me!
[RefFonds]
Set rst = CurrentDb.OpenRecordset(strSQL)
If rst.RecordCount <> 0 Then 's'il en existe
'on demande si tous les noms de rep équivalents doivent
être modifiés,
nbr = DCount("*", "Documents", "[RefFonds] = forms!
[FmrExpositionsDocumentsListe]![RefFonds] AND [AutreRefProjet] = """ &
AncNomRepProj & """")
If nbr > 1 Then
msg = "Il existe plusieurs enregistrements liés au
répertoire " & Me![AutreRefProjet] & "!" & Chr(13) & "Que voulez-vous
faire ? :" & Chr(13) & "- modifier tous les noms équivalents ? (cela
mettra également à jour les champs RefObjet) : valider Oui;
(Attention ! si la boîte de 'conflit d'écriture' s'affiche : cliquez
sur SAUVEGARDER) " & Chr(13) & "- modifier seulement l'enregistrement
en cours ? : valider Non. "
Style = vbYesNoCancel
Title = "QUELLES MODIFICATIONS ?"
Response = MsgBox(msg, Style, Title)
If Response = vbYes Then
'si oui :
'DoCmd.SetWarning False
rst.MoveFirst
While Not rst.EOF
rst.Edit
rst!AutreRefProjet = NouvNomRepProj
rst!RefobjDoc = MAJRefObjet
rst.Update
DoCmd.RunCommand acCmdSaveRecord
rst.MoveNext
Wend
rst.Close
Set rst = Nothing
DoCmd.RunCommand acCmdSaveRecord

'ON VERIFIE QU'EXISTE UN REPERTOIRE A l'ANCIEN
NOM
If dir(NomRepFonds & "" & AncNomRepProj,
vbDirectory) <> "" Then
If dir(NomRepFonds & "" & NouvNomRepProj,
vbDirectory) <> "" Then
MsgBox "Il existe déjà un répertoire
portant ce nom ! Merci de réunir dans UN SEUL répertoire les fichiers
concernant le projet !", vbExclamation, "DEUX REPERTOIRES POUR LE MEME
PROJET !"
Else
'on modifie le nom du répertoire
Name OldName As NewName ' Renomme le
fichier.
MsgBox "Le nom du répertoire a également
été modifié sur le serveur...", vbInformation, "NOM DU REPERTOIRE
MODIFIE"
End If
End If 'fin répertoire non existant
'Me.Refresh
ElseIf Response = vbNo Then
'il existe d'autres valeurs équivalentes mais
l'utilisateur veut seulement modifier l'enregistrement en cours
'Me.Undo
Me![AutreRefProjet] = NouvNomRepProj
End If
ElseIf nbr = 1 Then
Me![AutreRefProjet] = NouvNomRepProj
'ON VERIFIE QU'EXISTE UN REPERTOIRE A l'ANCIEN NOM
If dir(NomRepFonds & "" & AncNomRepProj, vbDirectory)
<> "" Then
If dir(NomRepFonds & "" & NouvNomRepProj,
vbDirectory) <> "" Then
MsgBox "Il existe déjà un répertoire portant ce
nom ! Merci de réunir dans UN SEUL répertoire les fichiers concernant
le projet !", vbExclamation, "DEUX REPERTOIRES POUR LE MEME PROJET !"
Else
'on modifie le nom du répertoire
Name OldName As NewName ' Renomme le fichier.
MsgBox "Le nom du répertoire a également été
modifié sur le serveur...", vbInformation, "NOM DU REPERTOIRE MODIFIE"
End If
End If 'fin répertoire non existant
End If
End If 'fin de vérif plusieurs enregistrements avec même
nom
End If 'fin vérif le nom a été modifié

ElseIf IsNull(Me![RefobjDoc]) Or Me![RefobjDoc] = "" Then 'pas de
RefObjet
If Not IsNull(Me![AutreRefProjet]) Or Me![AutreRefProjet] <> ""
Then 'si le champs AutreRefProj n'est pas vide
If Not IsNull(Me![AutreRefProjet].OldValue) Or Me!
[AutreRefProjet].OldValue <> "" Then 'si la valeur du champ a été
modifiée
's'il s'agit d'une modif : on enregistre les valeurs de
l'ancien et du nouveau nom ainsi que de l'hypothétique répertoire
correspondant
If Not IsNull(Me![AutreRefProjet].OldValue) Then
AncNomRepProj = Me![AutreRefProjet].OldValue
ElseIf IsNull(Me![AutreRefProjet].OldValue) Then
AncNomRepProj = Me![AutreRefProjet]
End If
NouvNomRepProj = Me![AutreRefProjet]

OldName = "I:" & Me![Abreviation] & "" & AncNomRepProj
'ON VERIFIE L'ECRITURE, on prépare les éléments de modif.
du nom
Dim NomAutreRefTrans As String
NomAutreRefTrans = Me![AutreRefProjet]
Dim Signal As Byte
Signal = SignalCaract(NomAutreRefTrans)
If Signal >= 1 Then 'écriture non conforme
'ON MODIFIE LE NOM DU CHAMP
NouvNomRepProj = EnleverAccents(NomAutreRefTrans)
NomAutreRefTrans = NouvNomRepProj
NouvNomRepProj = UCase(NomAutreRefTrans)
NomAutreRefTrans = NouvNomRepProj
Me![AutreRefProjet] = NomAutreRefTrans
NewName = "I:" & Me![Abreviation] & "" &
NouvNomRepProj
Else 'si aucun caractère n'est à modifier (le nom ayant
cependant changé)
'on modifie le nom que doit prendre le répertoire
NewName = "I:" & Me![Abreviation] & "" & Me!
[AutreRefProjet]
End If 'fin écriture conforme
DoCmd.RunCommand acCmdSaveRecord

'Vérif. plusieurs occurences portant le même nom
strSQL = "SELECT Documents.* FROM Documents WHERE
Documents.AutreRefProjet = """ & AncNomRepProj & """"
strSQL = strSQL & "AND (Documents.RefFonds) =" & Me!
[RefFonds]
Set rst = CurrentDb.OpenRecordset(strSQL)
If rst.RecordCount <> 0 Then 's'il en existe
'on demande si tous les noms de rep équivalents doivent
être modifiés,
'Me.RecordSource = strSQL
'Dim nbr As Integer
nbr = DCount("*", "Documents", "[RefFonds] = forms!
[FmrExpositionsDocumentsListe]![RefFonds] AND [AutreRefProjet] = """ &
AncNomRepProj & """")
If nbr >= 1 Then
msg = "Il existe plusieurs enregistrements liés au
répertoire " & Me![AutreRefProjet] & "!" & Chr(13) & "Que voulez-vous
faire ? :" & Chr(13) & "- modifier tous les noms équivalents ? :
valider Oui ; " & Chr(13) & "- modifier seulement l'enregistrement en
cours ? : valider Non. "
Style = vbYesNoCancel
Title = "QUELLES MODIFICATIONS ?"
Response = MsgBox(msg, Style, Title)
If Response = vbYes Then
'si oui :
rst.MoveFirst
While Not rst.EOF
rst.Edit
rst!AutreRefProjet = NouvNomRepProj
rst.Update
rst.MoveNext
Wend
rst.Close
Set rst = Nothing
'ON VERIFIE QU'EXISTE UN REPERTOIRE A l'ANCIEN
NOM
If dir(NomRepFonds & "" & AncNomRepProj,
vbDirectory) <> "" Then
If dir(NomRepFonds & "" & NouvNomRepProj,
vbDirectory) <> "" Then
MsgBox "Il existe déjà un répertoire
portant ce nom ! Merci de réunir dans UN SEUL répertoire les fichiers
concernant le projet !", vbExclamation, "DEUX REPERTOIRES POUR LE MEME
PROJET !"
Else
'on modifie le nom du répertoire
Name OldName As NewName ' Renomme le
fichier.
MsgBox "Le nom du répertoire a également
été modifié sur le serveur...", vbInformation, "NOM DU REPERTOIRE
MODIFIE"
End If
End If 'fin répertoire non existant
ElseIf Response = vbNo Then
'il existe d'autres valeurs équivalentes mais
l'utilisateur veut seulement modifier l'enregistrement en cours
Me![AutreRefProjet] = NouvNomRepProj
End If
ElseIf nbr = 1 Then
Me![AutreRefProjet] = NouvNomRepProj
'ON VERIFIE QU'EXISTE UN REPERTOIRE A l'ANCIEN NOM
If dir(NomRepFonds & "" & AncNomRepProj, vbDirectory)
<> "" Then
If dir(NomRepFonds & "" & NouvNomRepProj,
vbDirectory) <> "" Then
MsgBox "Il existe déjà un répertoire portant ce
nom ! Merci de réunir dans UN SEUL répertoire les fichiers concernant
le projet !", vbExclamation, "DEUX REPERTOIRES POUR LE MEME PROJET !"
Else
'on modifie le nom du répertoire
Name OldName As NewName ' Renomme le fichier.
MsgBox "Le nom du répertoire a également été
modifié sur le serveur...", vbInformation, "NOM DU REPERTOIRE MODIFIE"
End If
End If 'fin répertoire non existant
End If
End If 'fin de vérif plusieurs enregistrements avec même
nom
'ON VERIFIE QU'EXISTE UN REPERTOIRE A l'ANCIEN NOM
If dir(NomRepFonds & "" & AncNomRepProj, vbDirectory) <> ""
Then
If dir(NomRepFonds & "" & NouvNomRepProj, vbDirectory) <>
"" Then
MsgBox "Il existe déjà un répertoire portant ce nom !
Merci de réunir dans UN SEUL répertoire les fichiers concernant le
projet !", vbExclamation, "DEUX REPERTOIRES POUR LE MEME PROJET !"
Else
'on modifie le nom du répertoire
Name OldName As NewName ' Renomme le fichier.
MsgBox "Le nom du répertoire a également été modifié sur
le serveur...", vbInformation, "NOM DU REPERTOIRE MODIFIE"
End If
End If 'fin répertoire non existant
End If 'fin valeur modifiée (nouvel enregistrement)

ElseIf IsNull(Me![AutreRefProjet]) Then 'cas d'une suppression
DoCmd.RunCommand acCmdSaveRecord
'ON VERIFIE QU'EXISTE UN REPERTOIRE A l'ANCIEN NOM
If dir(NomRepFonds & "" & AncNomRepProj, vbDirectory) <> ""
Then
'On vérifie qu'il existe d'autres références équivalent es
strSQL = "SELECT Documents.* FROM Documents WHERE
Documents.AutreRefProjet = """ & AncNomRepProj & """"
strSQL = strSQL & "AND (Documents.RefFonds) =" & Me!
[RefFonds]
Set rst = CurrentDb.OpenRecordset(strSQL)
If rst.RecordCount <> 0 Then 's'il existe encore des
références équivalentes
Me.RecordSource = strSQL
Dim nbr1 As Integer
nbr1 = DCount("*", "Documents", "[RefFonds] = forms!
[FmrExpositionsDocumentsListe]![RefFonds] AND [AutreRefProjet] = """ &
AncNomRepProj & """")
If nbr1 < 1 Then
MsgBox "Attention : il existe encore un répertoire au
nom que vous avez supprimé et il n'y a plus d'enregistrements
correspondant...", vbInformation, "PLUS DE REF AU REPERTOIRE"
End If
End If
Else 'pas de répertoire
End If ''fin vérif si nouvel enregistrement
End If 'fin répertoire non existant
End If 'fin verif refobjetdoc
'Me.Refresh





Place ta Sub dans un module et tu pourras l'appeler de n'importe quelle
  procédure évementielle, par contre tu perds l'identification impl icite
  des contrôles (Me.???) au niveau de ta Sub, mais c'est tout de mê me la
  solution à privilégier.


Avatar
Michel__D
Re,

Disons que le plus simple serait de passer en paramêtre la référence
de l'objet Form.

Sub MaSub(Mf As Form)
' Tu remplace toutes les occurences de Me! ou Me. par Mf.
...
End Sub

Et pour appeler ta Sub :

' Si tu es dans le formulaire à traiter
MaSub Me
' Sinon
MaSub Forms("Nom_Du_Formulaire")


a écrit :
Bonjour Michel et merci pour ce conseil, que je supposes être fort
bon ;o)
Mais je veux bien être un peu "accompagnée" sur ce coup là...
Suffit-il que, une fois recopiée ma sub dans un module, je remplace
chaque référence à Me. par le nom de mon formulaire ou bien quelque
chose d'encore plus "neutre" (et si oui comment l'écrire : Form. ?)
Je supposes qu'à l'appel de ma procédure c'est le nom du formulaire
que je devrais préciser (genre VerifRef(NomForm) ?
Un peu paumée... Ci-dessous je recopie ma - très fastidieuse - sub (du
travail d'amateur : surement moyen de simplifier...mais fonctionne !)
Par avance encore merci,
Sonia.

'Déclarations messages
Dim msg, Style, Title, Response, MyString
Dim nbr As Integer
'Déclaration d'objets pour création
Dim RepObjet As Folder
Dim fso As New FileSystemObject
'déclaration pour call shell
Dim stAppName As String
'déclarations répertoires
Dim NomRepFonds As String
NomRepFonds = "I:" & Me![Abreviation]
Dim NomRepObjet As String
'Déclarations pour renommage
Dim db As Database
Dim strSQL As String
Dim rst As Recordset
Dim strSQL1 As String
strSQL1 = "SELECT ReqDocumentsListe.* FROM ReqDocumentsListe WHERE
ReqDocumentsListe.RefDoc =" & Me.RefDoc
Dim AncNomRepProj As String
Dim NouvNomRepProj As String
Dim MAJRefObjet As String
Dim OldName, NewName
OldName = "I:" & Me![Abreviation] & "" & AncNomRepProj
NewName = "I:" & Me![Abreviation] & "" & NouvNomRepProj

If Not IsNull(Me![RefobjDoc]) Or Me![RefobjDoc] <> "" Then
MAJRefObjet = Me![RefobjDoc]
AncNomRepProj = Me![AutreRefProjet]
NouvNomRepProj = Me![RefobjDoc].Column(1)
OldName = "I:" & Me![Abreviation] & "" & AncNomRepProj
NewName = "I:" & Me![Abreviation] & "" & NouvNomRepProj
Me![AutreRefProjet] = Me![RefobjDoc].Column(1)
If AncNomRepProj <> NouvNomRepProj Then
strSQL = "SELECT Documents.* FROM Documents WHERE
Documents.AutreRefProjet = """ & AncNomRepProj & """"
strSQL = strSQL & "AND (Documents.RefFonds) =" & Me!
[RefFonds]
Set rst = CurrentDb.OpenRecordset(strSQL)
If rst.RecordCount <> 0 Then 's'il en existe
'on demande si tous les noms de rep équivalents doivent
être modifiés,
nbr = DCount("*", "Documents", "[RefFonds] = forms!
[FmrExpositionsDocumentsListe]![RefFonds] AND [AutreRefProjet] = """ &
AncNomRepProj & """")
If nbr > 1 Then
msg = "Il existe plusieurs enregistrements liés au
répertoire " & Me![AutreRefProjet] & "!" & Chr(13) & "Que voulez-vous
faire ? :" & Chr(13) & "- modifier tous les noms équivalents ? (cela
mettra également à jour les champs RefObjet) : valider Oui;
(Attention ! si la boîte de 'conflit d'écriture' s'affiche : cliquez
sur SAUVEGARDER) " & Chr(13) & "- modifier seulement l'enregistrement
en cours ? : valider Non. "
Style = vbYesNoCancel
Title = "QUELLES MODIFICATIONS ?"
Response = MsgBox(msg, Style, Title)
If Response = vbYes Then
'si oui :
'DoCmd.SetWarning False
rst.MoveFirst
While Not rst.EOF
rst.Edit
rst!AutreRefProjet = NouvNomRepProj
rst!RefobjDoc = MAJRefObjet
rst.Update
DoCmd.RunCommand acCmdSaveRecord
rst.MoveNext
Wend
rst.Close
Set rst = Nothing
DoCmd.RunCommand acCmdSaveRecord

'ON VERIFIE QU'EXISTE UN REPERTOIRE A l'ANCIEN
NOM
If dir(NomRepFonds & "" & AncNomRepProj,
vbDirectory) <> "" Then
If dir(NomRepFonds & "" & NouvNomRepProj,
vbDirectory) <> "" Then
MsgBox "Il existe déjà un répertoire
portant ce nom ! Merci de réunir dans UN SEUL répertoire les fichiers
concernant le projet !", vbExclamation, "DEUX REPERTOIRES POUR LE MEME
PROJET !"
Else
'on modifie le nom du répertoire
Name OldName As NewName ' Renomme le
fichier.
MsgBox "Le nom du répertoire a également
été modifié sur le serveur...", vbInformation, "NOM DU REPERTOIRE
MODIFIE"
End If
End If 'fin répertoire non existant
'Me.Refresh
ElseIf Response = vbNo Then
'il existe d'autres valeurs équivalentes mais
l'utilisateur veut seulement modifier l'enregistrement en cours
'Me.Undo
Me![AutreRefProjet] = NouvNomRepProj
End If
ElseIf nbr = 1 Then
Me![AutreRefProjet] = NouvNomRepProj
'ON VERIFIE QU'EXISTE UN REPERTOIRE A l'ANCIEN NOM
If dir(NomRepFonds & "" & AncNomRepProj, vbDirectory)
<> "" Then
If dir(NomRepFonds & "" & NouvNomRepProj,
vbDirectory) <> "" Then
MsgBox "Il existe déjà un répertoire portant ce
nom ! Merci de réunir dans UN SEUL répertoire les fichiers concernant
le projet !", vbExclamation, "DEUX REPERTOIRES POUR LE MEME PROJET !"
Else
'on modifie le nom du répertoire
Name OldName As NewName ' Renomme le fichier.
MsgBox "Le nom du répertoire a également été
modifié sur le serveur...", vbInformation, "NOM DU REPERTOIRE MODIFIE"
End If
End If 'fin répertoire non existant
End If
End If 'fin de vérif plusieurs enregistrements avec même
nom
End If 'fin vérif le nom a été modifié

ElseIf IsNull(Me![RefobjDoc]) Or Me![RefobjDoc] = "" Then 'pas de
RefObjet
If Not IsNull(Me![AutreRefProjet]) Or Me![AutreRefProjet] <> ""
Then 'si le champs AutreRefProj n'est pas vide
If Not IsNull(Me![AutreRefProjet].OldValue) Or Me!
[AutreRefProjet].OldValue <> "" Then 'si la valeur du champ a été
modifiée
's'il s'agit d'une modif : on enregistre les valeurs de
l'ancien et du nouveau nom ainsi que de l'hypothétique répertoire
correspondant
If Not IsNull(Me![AutreRefProjet].OldValue) Then
AncNomRepProj = Me![AutreRefProjet].OldValue
ElseIf IsNull(Me![AutreRefProjet].OldValue) Then
AncNomRepProj = Me![AutreRefProjet]
End If
NouvNomRepProj = Me![AutreRefProjet]

OldName = "I:" & Me![Abreviation] & "" & AncNomRepProj
'ON VERIFIE L'ECRITURE, on prépare les éléments de modif.
du nom
Dim NomAutreRefTrans As String
NomAutreRefTrans = Me![AutreRefProjet]
Dim Signal As Byte
Signal = SignalCaract(NomAutreRefTrans)
If Signal >= 1 Then 'écriture non conforme
'ON MODIFIE LE NOM DU CHAMP
NouvNomRepProj = EnleverAccents(NomAutreRefTrans)
NomAutreRefTrans = NouvNomRepProj
NouvNomRepProj = UCase(NomAutreRefTrans)
NomAutreRefTrans = NouvNomRepProj
Me![AutreRefProjet] = NomAutreRefTrans
NewName = "I:" & Me![Abreviation] & "" &
NouvNomRepProj
Else 'si aucun caractère n'est à modifier (le nom ayant
cependant changé)
'on modifie le nom que doit prendre le répertoire
NewName = "I:" & Me![Abreviation] & "" & Me!
[AutreRefProjet]
End If 'fin écriture conforme
DoCmd.RunCommand acCmdSaveRecord

'Vérif. plusieurs occurences portant le même nom
strSQL = "SELECT Documents.* FROM Documents WHERE
Documents.AutreRefProjet = """ & AncNomRepProj & """"
strSQL = strSQL & "AND (Documents.RefFonds) =" & Me!
[RefFonds]
Set rst = CurrentDb.OpenRecordset(strSQL)
If rst.RecordCount <> 0 Then 's'il en existe
'on demande si tous les noms de rep équivalents doivent
être modifiés,
'Me.RecordSource = strSQL
'Dim nbr As Integer
nbr = DCount("*", "Documents", "[RefFonds] = forms!
[FmrExpositionsDocumentsListe]![RefFonds] AND [AutreRefProjet] = """ &
AncNomRepProj & """")
If nbr >= 1 Then
msg = "Il existe plusieurs enregistrements liés au
répertoire " & Me![AutreRefProjet] & "!" & Chr(13) & "Que voulez-vous
faire ? :" & Chr(13) & "- modifier tous les noms équivalents ? :
valider Oui ; " & Chr(13) & "- modifier seulement l'enregistrement en
cours ? : valider Non. "
Style = vbYesNoCancel
Title = "QUELLES MODIFICATIONS ?"
Response = MsgBox(msg, Style, Title)
If Response = vbYes Then
'si oui :
rst.MoveFirst
While Not rst.EOF
rst.Edit
rst!AutreRefProjet = NouvNomRepProj
rst.Update
rst.MoveNext
Wend
rst.Close
Set rst = Nothing
'ON VERIFIE QU'EXISTE UN REPERTOIRE A l'ANCIEN
NOM
If dir(NomRepFonds & "" & AncNomRepProj,
vbDirectory) <> "" Then
If dir(NomRepFonds & "" & NouvNomRepProj,
vbDirectory) <> "" Then
MsgBox "Il existe déjà un répertoire
portant ce nom ! Merci de réunir dans UN SEUL répertoire les fichiers
concernant le projet !", vbExclamation, "DEUX REPERTOIRES POUR LE MEME
PROJET !"
Else
'on modifie le nom du répertoire
Name OldName As NewName ' Renomme le
fichier.
MsgBox "Le nom du répertoire a également
été modifié sur le serveur...", vbInformation, "NOM DU REPERTOIRE
MODIFIE"
End If
End If 'fin répertoire non existant
ElseIf Response = vbNo Then
'il existe d'autres valeurs équivalentes mais
l'utilisateur veut seulement modifier l'enregistrement en cours
Me![AutreRefProjet] = NouvNomRepProj
End If
ElseIf nbr = 1 Then
Me![AutreRefProjet] = NouvNomRepProj
'ON VERIFIE QU'EXISTE UN REPERTOIRE A l'ANCIEN NOM
If dir(NomRepFonds & "" & AncNomRepProj, vbDirectory)
<> "" Then
If dir(NomRepFonds & "" & NouvNomRepProj,
vbDirectory) <> "" Then
MsgBox "Il existe déjà un répertoire portant ce
nom ! Merci de réunir dans UN SEUL répertoire les fichiers concernant
le projet !", vbExclamation, "DEUX REPERTOIRES POUR LE MEME PROJET !"
Else
'on modifie le nom du répertoire
Name OldName As NewName ' Renomme le fichier.
MsgBox "Le nom du répertoire a également été
modifié sur le serveur...", vbInformation, "NOM DU REPERTOIRE MODIFIE"
End If
End If 'fin répertoire non existant
End If
End If 'fin de vérif plusieurs enregistrements avec même
nom
'ON VERIFIE QU'EXISTE UN REPERTOIRE A l'ANCIEN NOM
If dir(NomRepFonds & "" & AncNomRepProj, vbDirectory) <> ""
Then
If dir(NomRepFonds & "" & NouvNomRepProj, vbDirectory) <>
"" Then
MsgBox "Il existe déjà un répertoire portant ce nom !
Merci de réunir dans UN SEUL répertoire les fichiers concernant le
projet !", vbExclamation, "DEUX REPERTOIRES POUR LE MEME PROJET !"
Else
'on modifie le nom du répertoire
Name OldName As NewName ' Renomme le fichier.
MsgBox "Le nom du répertoire a également été modifié sur
le serveur...", vbInformation, "NOM DU REPERTOIRE MODIFIE"
End If
End If 'fin répertoire non existant
End If 'fin valeur modifiée (nouvel enregistrement)

ElseIf IsNull(Me![AutreRefProjet]) Then 'cas d'une suppression
DoCmd.RunCommand acCmdSaveRecord
'ON VERIFIE QU'EXISTE UN REPERTOIRE A l'ANCIEN NOM
If dir(NomRepFonds & "" & AncNomRepProj, vbDirectory) <> ""
Then
'On vérifie qu'il existe d'autres références équivalentes
strSQL = "SELECT Documents.* FROM Documents WHERE
Documents.AutreRefProjet = """ & AncNomRepProj & """"
strSQL = strSQL & "AND (Documents.RefFonds) =" & Me!
[RefFonds]
Set rst = CurrentDb.OpenRecordset(strSQL)
If rst.RecordCount <> 0 Then 's'il existe encore des
références équivalentes
Me.RecordSource = strSQL
Dim nbr1 As Integer
nbr1 = DCount("*", "Documents", "[RefFonds] = forms!
[FmrExpositionsDocumentsListe]![RefFonds] AND [AutreRefProjet] = """ &
AncNomRepProj & """")
If nbr1 < 1 Then
MsgBox "Attention : il existe encore un répertoire au
nom que vous avez supprimé et il n'y a plus d'enregistrements
correspondant...", vbInformation, "PLUS DE REF AU REPERTOIRE"
End If
End If
Else 'pas de répertoire
End If ''fin vérif si nouvel enregistrement
End If 'fin répertoire non existant
End If 'fin verif refobjetdoc
'Me.Refresh




Place ta Sub dans un module et tu pourras l'appeler de n'importe quelle
procédure évementielle, par contre tu perds l'identification implicite
des contrôles (Me.???) au niveau de ta Sub, mais c'est tout de même la
solution à privilégier.





Avatar
sonia.gaubert
Génial ! ça marche au petit poil :o)

Merci, merci beaucoup Michel, et bonne fin de week-end à toi,
Sonia.