Fichier partagée et userform

Bonjour,

J'ai un fichier partagé et quand j'ouvre mon userform dans initialise j'incrémente un textbox avec ce code

Me.TxtN°ordredemission.Value = Sheets("Synthèse Ordre de mission").Range("A" & Rows.Count).End(xlUp).Value + 1

et en fait je voudrait une condition que si l'userform est déjà ouvert sur un poste un autre poste ne puisse l'ouvrir pour éviter d'incrémenter deux fois le même numéro et que ça pose problème lors de l'enregistrement.

Merci.

Bonjour,

Pour réaliser cela, je ne vois que cette solution :

1- utiliser une ressource partagée sur le réseau, par exemple un fichier texte

2- tenter d'ouvrir ce fichier au chargement du formulaire

3- mettre en attente l'exécution du code si le fichier est déjà ouvert, jusqu'à ce que le fichier soit fermé .

bonjour Thev,

j'ai pas tout compris, je créer un fichier texte que je place sur le réseau ensuite je tente de l'ouvrir

Application.Workbooks.Open ("\\Q:\Commun\partage plan de maintenance\reservation de vehicule.txt")

et c'est apres je fait comment pour ne pas le voir apparaitre? je ne comprend pas la suite...

Si tu peut me faire un petit bout de code merci.

Un exemple de code en utilisant un fichier Excel .xlsx

1- une boucle toutes les 5 secondes vérifiant que le fichier n'est pas ouvert en écriture

2- ouverture du classeur avec masquage de sa fenêtre avant chargement du formulaire

3- fermeture du classeur après déchargement du formulaire

4- fonction disant si le fichier est ouvert en écriture ou non

NB: il ne serait pas inutile de programmer un déchargement automatique du formulaire (avec fermeture du classeur de verrouillage) après un certain laps de temps afin que les autres postes ne soient pas bloqués en cas d'inactivité prolongée du poste ayant chargé le formulaire.

     '...variable à insérer au niveau du module ...............................
    Dim wb_lock As Workbook
    '.........................................................................

    '...code à insérer avant chargement du formulaire ........................
    nom_fic = "\\Q:\Commun\partage plan de maintenance\reservation de vehicule.xlsx"
    Do While IsFileOpenForWrite(nom_fic)
        date_fin = DateAdd("s", 5, Now)
        Application.Wait date_fin
    Loop
    Set wb_lock = Workbooks.Open(nom_fic)
    ActiveWindow.Visible = False
    '....fin code à insérer avant chargement du formulaire ...................

    '...code à insérer après déchargement du formulaire ........................
    Application.DisplayAlerts = False
    wb_lock.Close
    '....fin code à insérer après déchargement du formulaire ...................

Function IsFileOpenForWrite(ByVal nom_fichier As String) As Boolean
    Dim no_fichier As Long

    On Error Resume Next
    no_fichier = FreeFile()
    Open nom_fichier For Binary Access Read Lock Read Write As #no_fichier
    If Err.Number = 0 Then IsFileOpenForWrite = False _
    Else IsFileOpenForWrite = True
    Close no_fichier

End Function

Merci Thev tu à bien detaillé mais ca ne fonctionne pas j'ai une erreur sur la boucle.

je ne peut pas dire simplement à l'enregistrement de l'userform si numero existe dans feuille synthèse ordre de mission en colonne A prendre le suivant?

Au niveau d'un classeur partagé, tu auras un conflit dès lors que 2 postes tentent de mettre à jour une même cellule.

Pour éviter cela, il faut créer une boucle d'attente sur la libération d'une ressource. Cette ressource pourrait au final être une cellule fixe du classeur plutôt qu'un autre classeur du réseau.

Si cette cellule est remplie --> boucle d'attente de 5 secondes par exemple,

Sinon remplissage de la cellule et vidage de la cellule au déchargement du formulaire.

oui peut etre plus simple et plus rapide sur une cellule.

donc quand je click sur mon bouton pour ouvrir mon userform il faudrait que je remplisse une cellule et si cette cellule est deja rempli et qu'un autre poste clique sur l'ouverture de l'userform il renvoi un textbox attente et quand le premier a terminer et qu'on enregistre les données dans la feuille synthèse on supprime le remplissage de la cellule pour permettre à l'autre utilisateur d'ouvrir l'userform.

par contre je suis incapable de concevoir ce code si tu as un peu de temps à me consacrer se serait cool merci pour ton aide tu est vraiment tres calé.

Exemple de code avec utilisation d'un nom "verrou" plutôt que d'une cellule fixe.

1- création du nom (1 seule fois)

2- une boucle toutes les 5 secondes vérifiant que le nom n'est pas rempli

3- remplissage du nom

4- lancement d'un déchargement automatique du formulaire et d'une réinitialisation du nom au bout de 5 minutes pour ne pas bloquer les autres postes

5- réinitialisation possible du nom en cas de problème via le menu formules --> Gestionnaire de noms

    '...à exécuter une seule fois ...............................
    Names.Add Name:="verrou", RefersTo:="="""""
    '.........................................................................

    '...code à insérer avant chargement du formulaire ........................
    Do While Names("verrou").RefersTo = "=""mis"""
        date_fin = DateAdd("s", 5, Now)
        Application.Wait date_fin
    Loop
    Names("verrou").RefersTo =  "=""mis"""
    Application.OnTime Now + TimeValue("00:05:00"), "libération_formulaire"
    '....fin code à insérer avant chargement du formulaire ...................

    '...code à insérer après déchargement du formulaire ........................
    Names("verrou").RefersTo = "="""""
    '....fin code à insérer après déchargement du formulaire ...................

Sub libération_formulaire()

    On Error Resume Next
    Unload UserForm1
    Names("verrou").RefersTo = "="""""

End Sub

merci thev mais la ligne à exécuter une seule fois je la mets ou s'il te plait je n'arrive pas à faire fonctionner le code je comprend pas comment on met verrou et dans quelle cellule?

desolé...

"verrou" n'est pas une cellule mais un nom qui est stocké dans le classeur avec une valeur à blanc.

On laisse tomber la ligne à exécuter une fois. Le plus simple est de créer le nom "verrou" via le menu "Formules"

1) Formules --> Gestionnaire de noms --> cliquer sur nouveau

2) remplir la fenêtre comme l'image ci-dessous

3) cliquer sur OK

Le fait d'utiliser un nom plutôt qu'une cellule me parait assurer plus de compatibilité.

bonjour Thev,

J'ai essayé de faire comme tu ma dit mais ca ne fonctionne pas, j'ai mis le nom verrou OK ensuite quand j'ouvre l'userform sur le 1er poste OK le nom passe à "mis" mais quand j'ouvre sur un autre poste l'userform s'ouvre aussi avec le même numéro .

quand je fait le code pour liberer le formulaire je suis en erreur au niveau de " date_fin = DateAdd("s", 5, Now)"?

Merci

Bonjour,

reglaet a écrit :

quand je fait le code pour liberer le formulaire je suis en erreur au niveau de " date_fin = DateAdd("s", 5, Now)"?

Si tu es en "Option Explicit", il doit manquer la définition de date_fin

Dim date_fin as Date

Pour le reste, sans communication de ton code ou une version non confidentielle de ton classeur, il me sera difficile de t'aider plus avant.

Je te transmets le fichier quand le verrou et mis il bloque sur loop et au bout des 5 minutes il me mets un message d'erreur comme quoi il ne peut pas executer la macro de liberation ...

merci

Bonsoir,

reglaet a écrit :

Je te transmets le fichier quand le verrou et mis il bloque sur loop

C'est normal. L'exécution est mise en attente tant que le poste qui a pris la main, n'a pas libéré le verrou.

modif apportées :

1- déplacement de la procédure Libération_formulaire dans Feuil2(Menu)

2- modification de l'instruction en conséquence :

Application.OnTime Now + TimeValue("00:05:00"), "Feuil2.Libération_formulaire"

3- ajout initialisation du nom "verrou" dans la procédure Workbook_Open(), si 1 seul utilisateur du fichier

    With ThisWorkbook
        If UBound(.UserStatus) = 1 Then Names.Add Name:="verrou", RefersTo:="="""""
    End With

Bonjour thev et merci je viens de faire l'essai mais ça ne réagit pas comme je voudrait.

J'ouvre mon fichier excel partager sur un poste quand j'ouvre l'userform il prends un numéro et me met le verrou jusque la impeccable ensuite:

-1er problème si je ferme avec la croix rouge l'userform impossible d'y revenir car il y a le verrou

-2eme problème quand mon useform est ouvert si je vais sur un autre poste ouvrir mon fichier OK j'ouvre mon userform et la il s'ouvre et prend le même numéro que celui du 1er poste en fait je voudrais que si l'userform est ouvert sur un autre poste il y ai un message d'attente le temps que l'userform du poste 1 soit libérer si c'est possible?

Si je n'ai pas était très clair dans mon explication n'hésite pas à me demander.

reglaet a écrit :

-2eme problème quand mon useform est ouvert si je vais sur un autre poste ouvrir mon fichier OK j'ouvre mon userform et la il s'ouvre et prend le même numéro que celui du 1er poste en fait je voudrais que si l'userform est ouvert sur un autre poste il y ai un message d'attente le temps que l'userform du poste 1 soit libérer si c'est possible?

Donc ajout de l'instruction "ThisWorkBook.save" après positionnement du verrou.

reglaet a écrit :

1er problème si je ferme avec la croix rouge l'userform impossible d'y revenir car il y a le verrou

il suffit d'ajouter la procédure évenementielle : UserForm_Terminate

 
Private Sub UserForm_Terminate()

    Unload Ordredemission
    Names("verrou").RefersTo = "="""""
    ThisWorkbook.save

End Sub

ca marche mieux cette fois ci mais quand j'ouvre sur le second PC et que j'appui sur le bouton ordre de mission est-il possible de mettre un msgbox disant ordre de mission occupé si le verrou est mis et arreter l'action de l'appui du bouton car j'ai la souris qui tourne en permanence et je suis obligé d'arreter l'execution en faisant echap et annuler.Une fois le verrou enlever sur le 1er PC comment mettre a jour sur le 2eme PC le verrou sans réouvrir le fichier et est il possible d'avoir un msgbox pour dire ordre de mission libre?

c'est plus compliqué que ça ne parait le fait de partager le fichier...grrrrr tu m'aide vraiment Merci....

En fait, lorsque le classeur est partagé, il faut forcer sa mise à jour avant et pendant la boucle d'attente afin que chaque poste connaisse la position du verrou. Ci-dessous modification du code avec une boucle d'attente de 20 secondes et message de patience.

    ThisWorkbook.save
    If Names("verrou").RefersTo = "=""mis""" Then Patience.Show vbModeless
    Do While Names("verrou").RefersTo = "=""mis"""
        date_fin = DateAdd("s", 20, Now)
        Application.Wait date_fin
        ThisWorkbook.save
    Loop
    Unload Patience

Bonjour,

Je viens d'essayer ce code et j'ai deux petits problèmes le 1er quand j'ai la fenêtre patience qui s'ouvre je ne peut pas la fermer avec la croix rouge quand je ne suis pas en partage sa marche et si je suis en partage ça ne marche pas et ensuite 2eme erreur quand je referme sur le premier poste l'userform sur le deuxieme j'ai une erreur d'execution 1004 le fichier est vérrouillé essayé à nouveau ulterieurement je suis obligé de mettre fin et encore le verrou ne s'est pas enlevé j'ai un petit couac encore mais on se rapproche du resultat.

Merci.

Bonjour,

reglaet a écrit :

quand j'ai la fenêtre patience qui s'ouvre je ne peut pas la fermer avec la croix rouge

C'est exact, mais elle se ferme toute seule quand le premier poste libère le verrou.

reglaet a écrit :

quand je referme sur le premier poste l'userform sur le deuxieme j'ai une erreur d'execution 1004

Je n'ai pas cette erreur. Vous avez cette erreur quand vous fermez le formulaire sur le premier poste via le bouton "X" en haut à droite ?

Quand vous avez l'erreur, l'option débogage est-elle offerte ? Si oui quelle est l'instruction en cause ?