Classeurs avec macro partager

Le 18/11/2016 à 16:20

Bonjour à tous et à toutes,

Je me permets de vous ecrire car je suis arrivé à terme de mon projet excel consistant à rentrer des données par differents collaborateurs en feuille 1 et qui sont enregistrer par une macro en feuille 2.

apres avoir realisé tout le projet je me suis appercu que la saisie de donnée n'était pas réalisable en même temps par differents collaborateur car le classeur ne peut pas être partagé avoir differente saisie en même temps et indique un message d'erreur.

Il paraitrait possible de réaliser plusieurs saisie en même temps grace à :

'================================== ARCHIVAGE DES DONNEES T&F ==================================================================================================================================================================

'Vérifier que le fichier stérilité T&F n'est pas déjà ouvert

Dim lWorkbook As Workbook

Dim Found, Ouvert As Boolean

Found = False

For Each lWorkbook In Workbooks

If lWorkbook.Name = "Saisie Stérilité T&F.xls" Then

Found = True

Exit For

End If

Next

If Found = False Then

Workbooks.Open Filename:= _

"" & Worksheets("Paramètres").Cells(19, 3) & "", WriteResPassword:="sandrine"

'S'il n'est pas en lecture seule, lancer l'archivage

If Not (Workbooks("Saisie Stérilité T&F.xls").ReadOnly) Then

Workbooks("Saisie Stérilité T&F.xls").Worksheets("Liste").Activate

Application.Run "'Saisie Stérilité T&F.xls'!Archivage"

Workbooks("SUIVI_LOTS.xls").Save

Workbooks("Saisie Stérilité T&F.xls").Save

Workbooks("Saisie Stérilité T&F.xls").Close

Else

'Dans le cas où le fichier T&F est ouvert

Workbooks("Saisie Stérilité T&F.xls").Close

Ouvert = True

X = MsgBox("Le fichier de saisie du secteur Tubes & Flacons étant actuellement en cours d'utilisation, l'archivage ne peut pas être effectué. Merci de réessayer ultérieurement", vbCritical)

GoTo Fin

End If

End If

il faudrait mettre une boucle = regarder si le classeur est déjà ouvert, si oui, je mets une boucle temporelle de 5 minutes, par exemple, et je retente l'opération..

vu dans le forum mais je ne comprends pas ce qu'il faut faire car je ne suis absolument pas expert en VBA loin de là.

Je vous remerci par avance pour les solution que vous m'apporterez.

Bien à vous

Le 19/11/2016 à 23:48

Bonsoir,

Pour gérer une saisie multi-utilisateur sur un classeur non partagé, le principe est de de créer un temps d'attente permettant à chaque utilisateur d'effectuer tour à tour sa saisie dès que le classeur est disponible en mise à jour.

Ci-dessous exemple de code

Private Sub Workbook_Open()

    Application.DisplayAlerts = False
    If ThisWorkbook.ReadOnly Then
        réponse = MsgBox("Voulez-vous modifier ce fichier ?", vbYesNo + vbDefaultButton2)
        If réponse = vbYes Then
            Nom_fichier = ThisWorkbook.Path & "\" & ThisWorkbook.Name

            '..... contrôle libre accès classeur pour modification sinon attente 5 secondes .......................................
            Do While IsWorkBookOpenForWrite(Nom_fichier)
                date_fin = DateAdd("s", 5, Now)
                Application.Wait date_fin
            Loop
            '..... lancement nouvelle instance Excel avec ouverture fichier pour modification  ....................................
            Set xl = New Application
            xl.Visible = True
            xl.Workbooks.Open fileName:=Nom_fichier, IgnoreReadOnlyRecommended:=True

            '..... fermeture instance Excel avec ouverture fichier en lecture seule  ....................................
            Application.Quit
        End If
    End If

End Sub

Function IsWorkBookOpenforwrite(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 IsWorkBookOpenforwrite = False _
    Else IsWorkBookOpenforwrite = True
    Close no_fichier

End Function
Le 20/11/2016 à 23:52

Bonjour

Merci Thev pour votre réponse.

Neanmoins je ne saisie pas très bien le fonctionnement car dans mon cas le classeur doit être partager et ma saisie peut etre faite par n'importe quel utilisateur et même simultanément.

Est ce que le fais de rentrer ce code VBA va permettre au classeurs d'enregistrer automatiquement les saisie des utilisateurs mais a des temps differents même si la saisie ce fait en meme temps?

Car si il saisissent en même temps et que me classeur créé un temps d'attente pour pouvoir saisir mais que l'un des utilisateursferme le classeurs rapidement ca saisie peut être perdu ?

Par avance merci

Bonjour

Merci Thev pour votre réponse.

Neanmoins je ne saisie pas très bien le fonctionnement car dans mon cas le classeur doit être partager et ma saisie peut etre faite par n'importe quel utilisateur et même simultanément.

Est ce que le fais de rentrer ce code VBA va permettre au classeurs d'enregistrer automatiquement les saisie des utilisateurs mais a des temps differents même si la saisie ce fait en meme temps?

Car si il saisissent en même temps et que me classeur créé un temps d'attente pour pouvoir saisir mais que l'un des utilisateursferme le classeurs rapidement ca saisie peut être perdu ?

Par avance merci

Le 21/11/2016 à 00:33

Pour partager une saisie, le classeur ne doit précisément pas être défini comme partagé car la saisie concerne en général la même feuille et cela provoque des conflits de mise à jour.

Dès qu'un utilisateur a pris le contrôle du classeur en mise à jour, tous les autres utilisateurs sont en lecture seule et restent en attente jusqu'à ce que cet utilisateur ferme le classeur après avoir terminé sa mise à jour.

Le mieux est d'ailleurs de prévoir une fermeture automatique après la procédure de saisie ou après un certain laps de temps, car sinon les autres utilisateurs resteront bloqués.

Le 21/11/2016 à 19:34

Bonsoir,

Du coup si la saisie simulatané n'est pas possible comme vous l'avez expliqué.

Votre seconde option paraît être suffisamment adapté.

Est il possible de faire comme suit :

  • dans que la validation de la macro "enregistré" est saisie un msgbox s'affiche disant " votre saisie a bien été effectué, merci"
  • et directement après ca le classeur se ferme automatiquement .
  • et dans un 3eme temps si le classeur reste allumé plus de 15 minutes le classeur se ferme.

Est il possible de créer ces lignes de code s'il vous plaît ?

Je vous remercie pour vos réponses

dans l'attente de vous lire prochainement

a très bientôt

Le 21/11/2016 à 21:50

Bonsoir,

Dans le code associé à ThisWorkBook,

1- ajout d'une procédure publique de terminaison "Workbook_Terminate" à appeler par ThisWorkbook.Workbook_Terminate à la fin de la procédure de validation,

2- ajout de 2 lignes dans la procédure privée Workbook_Open pour lancer après 15 minutes la procédure "Workbook_Terminate"

Private Sub Workbook_Open()

    Application.DisplayAlerts = False
    If ThisWorkbook.ReadOnly Then
        réponse = MsgBox("Voulez-vous modifier ce fichier ?", vbYesNo + vbDefaultButton2)
        If réponse = vbYes Then
            Nom_fichier = ThisWorkbook.Path & "\" & ThisWorkbook.Name

            '..... contrôle libre accès classeur pour modification sinon attente 5 secondes .......................................
            Do While IsWorkBookOpenforwrite(Nom_fichier)
                date_fin = DateAdd("s", 5, Now)
                Application.Wait date_fin
            Loop
            '..... lancement nouvelle instance Excel avec ouverture fichier pour modification  ....................................
            Set xl = New Application
            xl.Visible = True
            xl.Workbooks.Open Filename:=Nom_fichier, IgnoreReadOnlyRecommended:=True
            '.... lancement procédure fermeture après 15 mns .................................................................
            xl.OnTime Now + TimeValue("00:15:00"), "ThisWorkbook.Workbook_Terminate"
           '..... fermeture instance Excel avec ouverture fichier en lecture seule  ....................................
            Application.Quit
        End If
    End If

End Sub

Sub Workbook_Terminate()

    'message fin validation
    MsgBox " votre saisie a bien été effectuée, merci"
    'sauvegarde classeur
    ThisWorkbook.Save
    'fermeture classeur
    ThisWorkbook.Close

End Sub

Function IsWorkBookOpenforwrite(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 IsWorkBookOpenforwrite = False _
    Else IsWorkBookOpenforwrite = True
    Close no_fichier

End Function
Le 21/11/2016 à 22:58

Thev,

J'ai tenté créer sur thisworkbook mais je ne trouve pas Terminate alors que je trouve le Open. pour y rentrer les lignes de code.

J'ai donc essayé de tout coller sur sur workbook Open mais cela n'a pas fonctionné et le visual basic ne répondait plus.

Ps : la 1er partie ;

Application.DisplayAlerts = False

If ThisWorkbook.ReadOnly Then

réponse = MsgBox("Voulez-vous modifier ce fichier ?", vbYesNo + vbDefaultButton2)

If réponse = vbYes Then

Nom_fichier = ThisWorkbook.Path & "\" & ThisWorkbook.Name Application.DisplayAlerts = False

est elle nécessaire ? car a chaque nouveau client ils vont faire une saisie c'est automatique puis pour enregistrer les données il y a un bouton enregistrer (macro) qui va envoyer les donnée enregistré dans une autre feuille.

Le 21/11/2016 à 23:14
bilel93 a écrit :

J'ai tenté créer sur thisworkbook mais je ne trouve pas Terminate alors que je trouve le Open. pour y rentrer les lignes de code.J'ai donc essayé de tout coller sur sur workbook Open mais cela n'a pas fonctionné et le visual basic ne répondait plus.

La procédure "Terminate" est de ma composition et n'est donc pas une procédure événementielle standard de ThisWorkBook. Elle doit donc être placée à part et doit rester publique (pas de Private devant) pour pouvoir être appelée par la procédure de validation. Cette procédure aurait pu être placée dans un module mais je trouve plus logique qu'elle soit associée à ThisWorkBook.

bilel93 a écrit :

réponse = MsgBox("Voulez-vous modifier ce fichier ?", vbYesNo + vbDefaultButton2) If réponse = vbYes Then

Le passage par cette boite de dialogue n'est effectivement pas nécessaire et le code peut donc être simplifié ainsi :

    Application.DisplayAlerts = False
    If ThisWorkbook.ReadOnly Then
         Nom_fichier = ThisWorkbook.Path & "\" & ThisWorkbook.Name
         '..... contrôle libre accès classeur pour modification sinon attente 5 secondes .......................................
         Do While IsWorkBookOpenforwrite(Nom_fichier)
             date_fin = DateAdd("s", 5, Now)
             Application.Wait date_fin
         Loop
         '..... lancement nouvelle instance Excel avec ouverture fichier pour modification  ....................................
         Set xl = New Application
         xl.Visible = True
         xl.Workbooks.Open Filename:=Nom_fichier, IgnoreReadOnlyRecommended:=True
         '.... lancement procédure fermeture après 15 mns .................................................................
         xl.OnTime Now + TimeValue("00:15:00"), "ThisWorkbook.Workbook_Terminate"
        '..... fermeture instance Excel avec ouverture fichier en lecture seule  ....................................
         Application.Quit
    End If
Le 25/11/2016 à 15:44

Bonjour Thev,

Tout d'abord merci pour les lignes de code que vous m'avez transmis , néanmoins je rencontre un problème car après avoir enregistré ma macro avec le bouton sur ma feuille le classeur ne s'éteint pas, et même quand je le laisse plus de 15 minutes sans le toucher il ne s'éteint pas non plus.

Peut être que j'ai mal mis les lignes de code que vous m'avez transmis dans mon ThisWorkBook, je vous prie de bien vouloir trouver ci dessous les lignes de code enregistré.

Si vous arrivez à trouver d'où vient la problématique je vous en serrais très reconnaissant.

Je reste a votre disposition pour toutes informations supplémentaires que je pourrais vous apporter. et vous remercie encore de l'implication que vous portez a mes interrogations.

a bientot

voici le code je l'avais mis dans commentaire mais ca ne fais pas comme vous :/

[code][/Private Sub Workbook_Open()

'declaration de la variable

Dim DateJour As Date

DateJour = Now()

'ouvrire directement sur le tableau de bord

Sheets("Tableau de bord").Activate

'se positionner sur la cellule

Range("c6").Select

'message d'ouverture

MsgBox " Bonjour et bienvenue sur DIBA" & vbCrLf & "Merci de bien fermer le classeur à la fin de la saisie" _

& vbCrLf & vbTab & Format(DateJour, "dddd dd mmmm yyyy"), vbOKOnly + vbInformation, "ATTENTION"

Application.DisplayAlerts = False

If ThisWorkbook.ReadOnly Then

Nom_fichier = ThisWorkbook.Path & "\" & ThisWorkbook.Name

'..... contrôle libre accès classeur pour modification sinon attente 5 secondes .......................................

Do While IsWorkBookOpenforwrite(Nom_fichier)

date_fin = DateAdd("s", 5, Now)

Application.Wait date_fin

Loop

'..... lancement nouvelle instance Excel avec ouverture fichier pour modification ....................................

Set xl = New Application

xl.Visible = True

xl.Workbooks.Open Filename:=Nom_fichier, IgnoreReadOnlyRecommended:=True

'.... lancement procédure fermeture après 15 mns .................................................................

xl.OnTime Now + TimeValue("00:15:00"), "ThisWorkbook.Workbook_Terminate"

'..... fermeture instance Excel avec ouverture fichier en lecture seule ....................................

Application.Quit

End If

End Sub

Sub Workbook_Terminate()

'message fin validation

MsgBox " votre saisie a bien été effectuée, merci"

'sauvegarde classeur

ThisWorkbook.Save

'fermeture classeur

ThisWorkbook.Close

End Sub

Function IsWorkBookOpenforwrite(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 IsWorkBookOpenforwrite = False _

Else IsWorkBookOpenforwrite = True

Close no_fichier

End Function

code]

Le 25/11/2016 à 20:13

Bonsoir,

Pour tester la procédure, il faut que le classeur soit ouvert en lecture seule. Cela se produira dès lors que 2 personnes ouvriront le classeur en même temps. L'une prendra le contrôle exclusif du classeur , l'autre se verra proposer de l'ouvrir en lecture seule et sera mis en attente jusqu'à ce le classeur soit libéré.

Pour tester, le plus simple est d'enregistrer le classeur en lecture seule recommandée via le bouton outils --> options générales.

La procédure à suivre est alors la suivante :

1- demander à vos utilisateurs d'ouvrir d'abord le classeur en lecture seule

2- dès que le classeur est disponible en mise à jour, une nouvelle application Excel est lancée avec le classeur ouvert en mise à jour

3- l'application Excel avec le classeur en lecture seule est alors fermée.

Il serait plus logique d'afficher votre message d'ouverture lorsque le classeur n'est pas en lecture seule, comme ceci

Private Sub Workbook_Open()
    'declaration de la variable
    Dim DateJour As Date
    DateJour = Now()
    'ouvrir directement sur le tableau de bord
    Sheets("Tableau de bord").Activate
    'se positionner sur la cellule
    Range("c6").Select

    Application.DisplayAlerts = False
    If ThisWorkbook.ReadOnly Then
         Nom_fichier = ThisWorkbook.Path & "\" & ThisWorkbook.Name
         '..... contrôle libre accès classeur pour modification sinon attente 5 secondes .......................................
         Do While IsWorkBookOpenforwrite(Nom_fichier)
             date_fin = DateAdd("s", 5, Now)
             Application.Wait date_fin
         Loop
         '..... lancement nouvelle instance Excel avec ouverture fichier pour modification  ....................................
         Set xl = New Application
         xl.Visible = True
         xl.Workbooks.Open Filename:=Nom_fichier, IgnoreReadOnlyRecommended:=True
         '.... lancement procédure fermeture après 15 mns .................................................................
         xl.OnTime Now + TimeValue("00:15:00"), "ThisWorkbook.Workbook_Terminate"
        '..... fermeture instance Excel avec ouverture fichier en lecture seule  ....................................
         Application.Quit
    Else
        'message d'ouverture
        MsgBox " Bonjour et bienvenue sur DIBA" & vbCrLf & "Merci de bien fermer le classeur à la fin de la saisie" _
        & vbCrLf & vbTab & Format(DateJour, "dddd dd mmmm yyyy"), vbOKOnly + vbInformation, "ATTENTION"
    End If

End Sub
Le 30/11/2016 à 11:13

Bonjour Thev,

Je viens de reprendre le travail ce matin et j'ai testé le code que vous m'avais donné, c'est excellent le principe fait que l'utilisateur qui ouvre le classeur ne peut rien faire dessus tant que l'autre ne l'a pas éteint, par contre la problématique c'est que le curseur de la souris se transforme en petit rond de chargement, et il devient impossible à l'utilisateur de réduire la fenêtre. est t'il possible d'avoir l'accès seulement au bouton de réduction d'écran et niv. inferieur et fermer ?

De plus lorsque la personne qui ouvre le classeur pour la saisie (donc pas en lecture seul) enregistre une macro via un bouton le classeur ne se met pas en lecture seul pour que la personne qui avait la "lecture seul" puisse prendre la main. Et au bout de 15 minute sans utilisation il ne se met pas en "lecture seule" automatiquement pour que celui qui attendait en "lecture seule" puisse prendre la main, j'ai donc baissé à 1minute pour le temps d'extinction mais ca n'a quand même pas fonctionné :/

Mais ce que vous avez fais est super le msgbox d'ouverture ne s'affiche que lorsque l'utilisateur à la main c'est vraiment top merci!

Voici les code saisie

Private Sub Workbook_Open()

'declaration de la variable

Dim DateJour As Date

DateJour = Now()

'ouvrir directement sur le tableau de bord

Sheets("Tableau de bord").Activate

'se positionner sur la cellule

Range("c6").Select

Application.DisplayAlerts = False

If ThisWorkbook.ReadOnly Then

Nom_fichier = ThisWorkbook.Path & "\" & ThisWorkbook.Name

'..... contrôle libre accès classeur pour modification sinon attente 5 secondes .......................................

Do While IsWorkBookOpenforwrite(Nom_fichier)

date_fin = DateAdd("s", 5, Now)

Application.Wait date_fin

Loop

'..... lancement nouvelle instance Excel avec ouverture fichier pour modification ....................................

Set xl = New Application

xl.Visible = True

xl.Workbooks.Open Filename:=Nom_fichier, IgnoreReadOnlyRecommended:=True

'.... lancement procédure fermeture après 15 mns .................................................................

xl.OnTime Now + TimeValue("00:01:00"), "ThisWorkbook.Workbook_Terminate"

'..... fermeture instance Excel avec ouverture fichier en lecture seule ....................................

Application.Quit

Else

'message d'ouverture

MsgBox " Bonjour et bienvenue sur DIBA" & vbCrLf & "Merci de bien fermer le classeur à la fin de la saisie" _

& vbCrLf & vbTab & Format(DateJour, "dddd dd mmmm yyyy"), vbOKOnly + vbInformation, "ATTENTION"

End If

End Sub

Sub Workbook_Terminate()

'message fin validation

MsgBox " votre saisie a bien été effectuée, merci"

'sauvegarde classeur

ThisWorkbook.Save

'fermeture classeur

ThisWorkbook.Close

End Sub

Function IsWorkBookOpenforwrite(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 IsWorkBookOpenforwrite = False _

Else IsWorkBookOpenforwrite = True

Close no_fichier

End Function

Le 30/11/2016 à 11:58
bilel93 a écrit :

par contre la problématique c'est que le curseur de la souris se transforme en petit rond de chargement, et il devient impossible à l'utilisateur de réduire la fenêtre. est t'il possible d'avoir l'accès seulement au bouton de réduction d'écran et niv. inferieur et fermer ?

A priori, cela devrait se résoudre en remplaçant le temps d'attente de 5 secondes par un "Doevents", comme ceci :

         Do While IsWorkBookOpenforwrite(Nom_fichier)
             DoEvents
         Loop
bilel93 a écrit :

Et au bout de 15 minute sans utilisation il ne se met pas en "lecture seule" automatiquement

Si le classeur est directement ouvert en mode saisie, il faut alors insérer à nouveau une fermeture temporisée, comme ceci :

    Else
        'message d'ouverture
        MsgBox " Bonjour et bienvenue " & vbCrLf & "Merci de bien fermer le classeur à la fin de la saisie" _
        & vbCrLf & vbTab & Format(DateJour, "dddd dd mmmm yyyy"), vbOKOnly + vbInformation, "ATTENTION"
        '.... lancement procédure fermeture après 15 mns .................................................................
        Application.OnTime Now + TimeValue("00:15:00"), "ThisWorkbook.Workbook_Terminate"

ci-dessous nouveau code complet

Private Sub Workbook_Open()

    Application.DisplayAlerts = False
    If ThisWorkbook.ReadOnly Then
         Nom_fichier = ThisWorkbook.Path & "\" & ThisWorkbook.Name
         '..... contrôle libre accès classeur pour modification sinon attente 5 secondes .......................................
         Do While IsWorkBookOpenforwrite(Nom_fichier)
             DoEvents
         Loop
         '..... lancement nouvelle instance Excel avec ouverture fichier pour modification  ....................................
         Set xl = New Application
         xl.Visible = True
         xl.Workbooks.Open Filename:=Nom_fichier, IgnoreReadOnlyRecommended:=True
         '.... lancement procédure fermeture après 15 mns .................................................................
         xl.OnTime Now + TimeValue("00:15:00"), "ThisWorkbook.Workbook_Terminate"
        '..... fermeture instance Excel avec ouverture fichier en lecture seule  ....................................
         Application.Quit
    Else
        'message d'ouverture
        MsgBox " Bonjour et bienvenue " & vbCrLf & "Merci de bien fermer le classeur à la fin de la saisie" _
        & vbCrLf & vbTab & Format(DateJour, "dddd dd mmmm yyyy"), vbOKOnly + vbInformation, "ATTENTION"
        '.... lancement procédure fermeture après 15 mns .................................................................
        Application.OnTime Now + TimeValue("00:15:00"), "ThisWorkbook.Workbook_Terminate"
    End If

End Sub
Le 30/11/2016 à 16:15

Thev,

Déjà merci beaucoup pour la rapidité de votre réponse j'ai remis en place ce que vous m'avez envoyer dans le VBA. du coup je ne peux toujours pas réduire ma fenêtre, mais je peux changer de feuille et écrire contrairement à l'autre ligne VBA qui bloqué la page ce qui était mieux :/

et pour la fermeture le classeur se ferme quelque minutes après avoir activité la macro.

A oui est même quand je ne fais pas de saisie et qu'il se ferme automatiquement il me note le msgbox "votre saisie a bien été effectué merci"

est il possible de mettre en place un message different entre la saisie qui dirait ""votre saisie a bien été effectué merci"

et la fermeture automatique qui dirais "Par manque d'activité le classeur a été fermé merci de re essayer" ?

Le 30/11/2016 à 17:45

Thev, au final la réduction de la fenêtre fonctionne, mais la saisie sur le classeur aussi malheureusement est il donc possible de laisser le curseur charger mais juste avoir l'accès a la réduction et la fermeture de la fenêtre.

Le classeur s'éteint au bout de 15 minutes tout seul c'est super, pour améliorer la chose est-il possible de supprimé le bouton "OK" car tant que l'on appuie pas sur le bouton l'autre utilisateur n'a pas l'accès a la saisie.

Mais toutes les solution que vous avez apporté fonctionne très bien et la manière dont vous expliquez les choses est vraiment très claire !!!

Le 01/12/2016 à 11:21
bilel93 a écrit :

au final la réduction de la fenêtre fonctionne, mais la saisie sur le classeur aussi malheureusement

La solution pour éviter la saisie, puisque le classeur est dans ce cas en lecture seule, est d'insérer cette instruction au début de la procédure de saisie

     If ThisWorkbook.ReadOnly Then
        MsgBox "Saisie impossible car classeur en lecture seule"
        Exit Sub
    End If
Le 01/12/2016 à 17:57

Bonjour Thev ,

J'ai testé la formule que vous avez suggéré mais elle ne fonctionne pas, je peux toujours saisir et changer de feuille.

Bien à vous

Peux être ai-je mal saisie la formule ?

Private Sub Workbook_Open()

    Application.DisplayAlerts = False
    If ThisWorkbook.ReadOnly Then
         Nom_fichier = ThisWorkbook.Path & "\" & ThisWorkbook.Name
         '..... contrôle libre accès classeur pour modification sinon attente 5 secondes .......................................
         Do While IsWorkBookOpenforwrite(Nom_fichier)
             DoEvents
         Loop
         '..... lancement nouvelle instance Excel avec ouverture fichier pour modification  ....................................
         Set xl = New Application
         xl.Visible = True
         xl.Workbooks.Open Filename:=Nom_fichier, IgnoreReadOnlyRecommended:=True
         '.... lancement procédure fermeture après 15 mns .................................................................
         xl.OnTime Now + TimeValue("00:15:00"), "ThisWorkbook.Workbook_Terminate"
        '..... fermeture instance Excel avec ouverture fichier en lecture seule  ....................................
         Application.Quit
    Else
        'message d'ouverture
        MsgBox " Bonjour et bienvenue " & vbCrLf & "Merci de bien fermer le classeur à la fin de la saisie" _
        & vbCrLf & vbTab & Format(DateJour, "dddd dd mmmm yyyy"), vbOKOnly + vbInformation, "ATTENTION"
        '.... lancement procédure fermeture après 15 mns .................................................................
        Application.OnTime Now + TimeValue("00:15:00"), "ThisWorkbook.Workbook_Terminate"
    End If
    If ThisWorkbook.ReadOnly Then
        MsgBox "Saisie impossible car classeur en lecture seule"
        Exit Sub
    End If

End Sub
Le 02/12/2016 à 10:43

Bonjour,

Ma suggestion était relative à la macro que vous avez mise en place

Je me permets de vous ecrire car je suis arrivé à terme de mon projet excel consistant à rentrer des données par differents collaborateurs en feuille 1 et qui sont enregistrer par une macro en feuille 2.

C'est dans la procédure liée à votre macro qu'il faut mettre en place cette instruction. Vous pouvez en sus dans la procédure d'ouverture du fichier, ajouter un message d'avertissement agrémenté d'une protection de la feuille 1 pour empêcher toute saisie, protection qui sera retirée lorsque que le classeur pourra être ouvert en mode saisie .

Private Sub Workbook_Open()

    Application.DisplayAlerts = False
    If ThisWorkbook.ReadOnly Then
         MsgBox "Attention ce fichier est pour le moment en lecture seule. Aucune saisie ne sera prise en compte !"
         '.... protection Feuille 1 .................................................................
         Sheets("Feuil1").Protect
         '..... contrôle libre accès classeur pour modification sinon attente 5 secondes .......................................
         Nom_fichier = ThisWorkbook.Path & "\" & ThisWorkbook.Name
         Do While IsWorkBookOpenforwrite(Nom_fichier)
             DoEvents
         Loop
         '..... lancement nouvelle instance Excel avec ouverture fichier pour modification  ....................................
         Set xl = New Application
         xl.Visible = True
         xl.Workbooks.Open Filename:=Nom_fichier, IgnoreReadOnlyRecommended:=True
         '.... libération Feuille 1 .................................................................
         Sheets("Feuil1").Unprotect
         '.... lancement procédure fermeture après 15 mns .................................................................
         xl.OnTime Now + TimeValue("00:15:00"), "ThisWorkbook.Workbook_Terminate"
        '..... fermeture instance Excel avec ouverture fichier en lecture seule  ....................................
         Application.Quit
    Else
        'message d'ouverture
        MsgBox " Bonjour et bienvenue " & vbCrLf & "Merci de bien fermer le classeur à la fin de la saisie" _
        & vbCrLf & vbTab & Format(DateJour, "dddd dd mmmm yyyy"), vbOKOnly + vbInformation, "ATTENTION"
        '.... lancement procédure fermeture après 15 mns .................................................................
        Application.OnTime Now + TimeValue("00:15:00"), "ThisWorkbook.Workbook_Terminate"
    End If

End Sub
Le 08/12/2016 à 15:27

Bonjour Thev,

Il m'est très difficile de vous répondre rapidement car je suis en formation, je n'ai donc pas accès a mon classeur bien souvent pour vous répondre, je m'en excuse.

J'ai testé la formule que vous avez donnée mais rien n'y fait la saisie est tout de même réalisable en lecture seul, le classeur affiche bien le msgbox comme quoi nous sommes en lecture seul. mais la feuille1 "Tableau de bord" peut toujours recevoir des saisies.

PS: en réalité il faudrait que la feuille1 "Tableau de bord" et la feuille2 "Hall ; Parking" ne puisse pas recevoir de saisie en lecture seul, qu'il soit impossible d'écrire dans une cellule. Mais ce qui serait formidable c'est que lors de l'ouverture en lecture seul la personne reste bloqué en feuille1 "Tableau de bord" sans qu'il puisse écrire ou que ce soit jusqu'à ce que le classeur ce libère.

Par avance je vous remercie Thev !!!

Bien à vous

Private Sub Workbook_Open()

    Application.DisplayAlerts = False
    If ThisWorkbook.ReadOnly Then
         MsgBox "Attention ce fichier est pour le moment en lecture seule. Aucune saisie ne sera prise en compte !"
         '.... protection Feuille 1 .................................................................
         Sheets("Tableau de bord").Protect
         '..... contrôle libre accès classeur pour modification sinon attente 5 secondes .......................................
         Nom_fichier = ThisWorkbook.Path & "\" & ThisWorkbook.Name
         Do While IsWorkBookOpenforwrite(Nom_fichier)
             DoEvents
         Loop
         '..... lancement nouvelle instance Excel avec ouverture fichier pour modification  ....................................
         Set xl = New Application
         xl.Visible = True
         xl.Workbooks.Open Filename:=Nom_fichier, IgnoreReadOnlyRecommended:=True
         '.... libération Feuille 1 .................................................................
         Sheets("Tableau de bord").Unprotect
         '.... lancement procédure fermeture après 15 mns .................................................................
         xl.OnTime Now + TimeValue("00:15:00"), "ThisWorkbook.Workbook_Terminate"
        '..... fermeture instance Excel avec ouverture fichier en lecture seule  ....................................
         Application.Quit
    Else
        'message d'ouverture
        MsgBox " Bonjour et bienvenue " & vbCrLf & "Merci de bien fermer le classeur à la fin de la saisie" _
        & vbCrLf & vbTab & Format(DateJour, "dddd dd mmmm yyyy"), vbOKOnly + vbInformation, "ATTENTION"
        '.... lancement procédure fermeture après 15 mns .................................................................
        Application.OnTime Now + TimeValue("00:15:00"), "ThisWorkbook.Workbook_Terminate"
    End If

End Sub
Le 08/12/2016 à 17:21
bilel93 a écrit :

mais rien n'y fait la saisie est tout de même réalisable en lecture seul, le classeur affiche bien le msgbox comme quoi nous sommes en lecture seul. mais la feuille1 "Tableau de bord" peut toujours recevoir des saisies.

Si les cellules de la feuille1 "Tableau de bord" sont verrouillées (elles le sont par défaut) et si cette feuille est protégée, aucune saisie dans les cellules n'est possible.

Il faudrait préciser comment s'effectue la saisie, directement dans les cellules de la feuille ou via un formulaire. Le mieux serait que vous joignez un exemplaire de cette feuille.

Le 16/12/2016 à 11:35

Bonjour Thev,

certaine cellule de la feuille ne sont pas protégé car il faut faire les saisies quand on est plus en lecture seul. mais avec ce code vba la personne qui en lecture seul reçoit le message comme quoi il faut qu'elle attende que le classeur ce libère mais peut tout de même écrire dans les cellules.

Je vous joint ci dessous le classeur, j'ai été contraint par confidentialité de supprimé toutes les données :/ néanmoins la problématique peux être résolu grâce a ce classeur

Par avance merci Thev !!

35excel-pour-forum.xlsm (62.02 Ko)
Rechercher des sujets similaires à "classeurs macro partager"