Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
J'ai un classeur enregistrement des pertes et un classeur inventaire production.
Mon classeur enregistrement des pertes est un formulaire qui est rempli par 9 utilisateurs différents mais chaque utilisateur a son propre formulaire.
Ma base de donnée centrale est l'inventaire production
Des données vont être transféré des différents classeurs enregistrement vers la base de données centrales inventaire production.
Afin que cela fonctionne, dans ma macro transfert de données, j'ai déjà prévu que le classeur inventaire production soit sauvegardé et refermé immédiatement après le transfert de données.
Mais je ne souhaite prendre aucun risque et ce que je veux maintenant c'est qu' au cas où le classeur inventaire production soit ouvert par une personne X alors une personne Y ne pourra pas cliquer sur le bouton et une messagebox affichera"classeur déjà ouvert" par exemple.
Ce bout de macro doit être situé avant le démarrage de ma macro transfert de données.
J'ai oublié de notifier que ces fichiers seront partagés en réseau.
enregistrement des pertes
Cijoint.fr - Service gratuit de dépôt de fichiers
Je vois qu'il y a plusieurs boutons identiques dans votre fichier.
Je suppose que :
- ils lancent la même macro
- à chaque clic la macro ouvre le fichier inventaire production.xls , entre les données puis enregistre et ferme le fichier.
Dans ces conditions, il vous suffit de mettre en début de macro :
Code:
On Error Resume Next
If IsError(Workbooks("inventaire production.xls").Name) Then GoTo 1
MsgBox "Le fichier 'inventaire production' est indisponible"
Exit Sub
1 On Error GoTo 0
En ce qui concerne la macro, elle fonctionne très bien sur un seul ordinateur. Par contre, dès qu'il s'agit de partager en réseau ces fichiers, cette gestion des erreurs ne fonctionne plus. La macro arrive à ouvrir le classeur inventaire production en lecture seule.
Je voulais savoir s'il n'y avait pas un moyen de bloquer l'accès en lecture seule également.
Je ne suis pas bien compétent sur les partages de classeur, mais essayez peut-être :
Code:
On Error Resume Next
If IsError(Workbooks("inventaire production.xls").Name) Then GoTo 1
[COLOR="Red"]2[/COLOR] MsgBox "Le fichier 'inventaire production' est indisponible"
Exit Sub
1 On Error GoTo 0
'mettre ici le code d'ouverture du fichier
If ActiveWorkbook.[COLOR="Red"]ReadOnly[/COLOR] Then ActiveWorkbook.Close False: GoTo 2
Encore merci. La gestion des erreurs se fait correctement. Si j'ouvre l'inventaire production sur un autre ordinateur, il m'indique immédiatement la message box.
Par contre, l'éxécution de la macro ne se fait plus correctement. En fait, j'ai plusieurs cas où le bouton macro doit se bloquer dont un où la macro affiche "ligne déjà copiée" si la ligne est coloré en jaune.
J'ai donc trois cas où la macro ne doit pas fonctionner:
Dans l'ordre:
1-le cas où le classeur est déjà ouvert(le cas que l'on a vu ensemble)
2-le cas où il n'y a pas d'initiales dans la case D7(l'opérateur n'a pas inscrit ses initiales)
3-le cas où la ligne est coloré en jaune(ligne déjà copié)
Mon problème est qu'il doit y avoir un chevauchement entre les erreurs.
Si j'éxecute la macro dans le cas normal(classeur inventaire prod fermé, initiales bien renseigné en D7 et ligne coloré en blanc), ma macro ouvre le classeur inventaire production et la messagebox affiche"ligne déjà copié"
Avez vous une idée d'où cela peut venir????
Je vois joins les deux fichiers exemples et le code de la macro pour vous faciliter la tâche.
enregistrement des pertes
Cijoint.fr - Service gratuit de dépôt de fichiers
Code
Code:
Sub testvalidation()
On Error Resume Next
If IsError(Workbooks("inventaire production.xls").Name) Then GoTo 1
2 MsgBox "Le fichier 'inventaire production' est indisponible"
Exit Sub
1 On Error GoTo 0
Workbooks.Open "\\S110dvp02\chefeq\STAGE S QUINQUIS\maquette logiciel\inventaire production.xls"
If ActiveWorkbook.ReadOnly Then ActiveWorkbook.Close False: GoTo 2
If ActiveSheet.Range("D7") = "" Then MsgBox "Veuillez Entrer vos initiales ": Exit Sub
If ActiveSheet.Range("B7:G7").Interior.ColorIndex <> 2 Then MsgBox "Ligne déjà Copiée": Exit Sub
Workbooks.Open "\\S110dvp02\chefeq\STAGE S QUINQUIS\maquette logiciel\inventaire production.xls"
Rows("7:7").Select
Selection.Insert Shift:=xlDown
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Interior.ColorIndex = 2
Selection.Font.ColorIndex = 0
ActiveWindow.SmallScroll ToRight:=-4
Range("H7:EL7").Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Windows("Enregistrement des pertes.xls").Activate
Range("B7").Select
Selection.Copy
Windows("inventaire production exemple 2.xls").Activate
Range("C7").Select
ActiveSheet.Paste
Windows("enregistrement des pertes.xls").Activate
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("inventaire production exemple 2.xls").Activate
Range("B7").Select
ActiveSheet.Paste
Windows("enregistrement des pertes.xls").Activate
Range("D7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("inventaire production exemple 2.xls").Activate
Range("E7").Select
ActiveSheet.Paste
Windows("enregistrement des pertes.xls").Activate
Range("E7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("inventaire production exemple 2.xls").Activate
Range("D7").Select
ActiveSheet.Paste
Windows("enregistrement des pertes.xls").Activate
Range("F7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("inventaire production exemple 2.xls").Activate
Range("F7").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows("enregistrement des pertes.xls").Activate
Range("G7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("inventaire production exemple 2.xls").Activate
Range("G7").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
ActiveWindow.SmallScroll ToRight:=-7
Range("B7:G7").Select
Selection.Interior.ColorIndex = 6
End Sub
Par contre votre code est à corriger : les lignes en rouge ouvrent 2 fois le fichier, et les tests sont mal placés.
Donc remplacer :
Code:
1 On Error GoTo 0
[COLOR="Red"]Workbooks.Open "\\S110dvp02\chefeq\STAGE S QUINQUIS\maquette logiciel\inventaire production.xls"[/COLOR]
If ActiveWorkbook.ReadOnly Then ActiveWorkbook.Close False: GoTo 2
If ActiveSheet.Range("D7") = "" Then MsgBox "Veuillez Entrer vos initiales ": Exit Sub
If ActiveSheet.Range("B7:G7").Interior.ColorIndex <> 2 Then MsgBox "Ligne déjà Copiée": Exit Sub
[COLOR="red"]Workbooks.Open "\\S110dvp02\chefeq\STAGE S QUINQUIS\maquette logiciel\inventaire production.xls"[/COLOR]
Rows("7:7").Select
par :
Code:
1 On Error GoTo 0
If ActiveSheet.Range("D7") = "" Then MsgBox "Veuillez Entrer vos initiales ": Exit Sub
If ActiveSheet.Range("B7:G7").Interior.ColorIndex <> 2 Then MsgBox "Ligne déjà Copiée": Exit Sub
Workbooks.Open "\\S110dvp02\chefeq\STAGE S QUINQUIS\maquette logiciel\inventaire production.xls"
If ActiveWorkbook.ReadOnly Then ActiveWorkbook.Close False: GoTo 2
Rows("7:7").Select
Nota : et puis travaillez un peu VBA pour éviter tous ces Select qui ne servent à rien, on se tue à le répéter sur ce forum 🙄
Désolé pour les Select. Je suis nouveau en VBA et j'essaie de comprendre comment cela fonctionne.
Concernant la macro, elle fonctionne mais le gestionnaire d'erreurs plante dans deux cas:
1)si un opérateur ne rentre pas ses initiales, la message box "veuillez entrer vos initiales" s'affiche. Jusqu'ici pas de problème. Par contre si l'opérateur rentre ses initiales après l'affichage de cette messagebox et valide, la messagebox réapparaît alors que je voudrais qu'il transfert cette information
2) Si un opérateur valide une ligne qui est affiché en jaune, la messagebox "ligne déjà copiée" doit s'afficher or ici la validation se fait correctement et ma ligne est copié en jaune dans mon autre fichier
Merci
Enregistrement des pertes
Cijoint.fr - Service gratuit de dépôt de fichiers
J'utilise le même procédé avec plus de 20 utilisateurs sur plusieurs sites pour un planning de réception.
Je contourne les effets d'accès simultané avec cette petite routine dans une fonction :
Function Acces_Base(Ma_Base_de_données_en_ligne As String) As Boolean
Dim A As Integer, filenum As Integer, errnum As Integer, Chemin As String
A = 1
Ecriture:
On Error Resume Next
filenum = FreeFile()
Open "Ma_Base_de_données_en_ligne" For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
Acces_Base = True
Workbooks.Open "Ma_Base_de_données_en_ligne"
Case Else
MsgBox "Le fichier source est actuellement occupé après " & A & " tentative (" & (3 - A) & " restantes)", vbInformation, "Base occupée"
Application.Wait (Now + TimeValue("0:00:03"))
A = A + 1
If A < 4 Then
GoTo Ecriture
Else
MsgBox "Le fichier source est actuellement occupé après 3 tentatives" & Chr(10) & Chr(13) & "Merci de rééssayer ultérieurement", vbCritical, "Base occupée"
Acces_Base = False
End If
End Select
End function
Le truc n'est pas de bloquer le bouton d'écriture de la macro mais de faire attendre l'ouverture du fichier de 3 secondes avant de retenter.
Evidemment, il faut que les fonctions de lecture de la base de données et d'écritures soient au point...
J'en profite aussi pour préciser que le fichier qui contient les macros est en lecture seule sur le réseau et donc que 20 utilisateurs peuvent ouvrir le même fichier qui pilote la base de données en ligne. Et que personne n'ouvre directement cette base de données.
Je vais suivre les conseils de Job75 et essayer de cerner d'où vient le problème. Ma macro de transfert a déjà fonctionner mais je vais reprendre un par un la gestion des erreurs et voir ce qui me fait planter.
Merci à Ubot303 mais ma base n'est pas sur access mais sur excel.
La mienne aussi.
C'est la fonction que j'ai nommé Acces_Base (du verbe Accéder) et non pas Access_Base...
Le mieux est de ne pas trop lire en diagonale, car j'ai rencontré les 2 mêmes problématiques (multi accès et mise à jour d'une base en ligne) et j'ai posté les solutions trouvées.
Comme je l'ai dit, je ne suis pas expert en classeurs partagés.
Mais tout ce qui a été fait dans les posts précédents vise à ce que le fichier partagé ne soit ouvert et traité que par un seul utilisateur à la fois 😉
Par ailleurs la macro qui traite les données n'est pas du tout dans le classeur partagé, c'est évident.
Je suis vraiment con. En fait je m'étais embrouillé dans la nomination de certaines cellules donc logique que ça marche pas.......
Merci beaucoup Job75, ta solution fonctionne très bien.
Quant à Ubot 303, je testerai ta solution d'ici lundi pour voir si elle fonctionne.
Merci à vous deux et bon week end!!!
Le fichier qui contient les données (appelons le "La Base") n'est ouvert que par une source en même temps.
Le principe appliqué est que les utilisateurs passent par un autre fichier (appelons le "Portail") qui ne contient aucune donnée mais les macros de lecture/ecriture de "La Base".
Ainsi aucun utilisateur n'accède en direct à "La Base" mais les macros se chargent d'ouvrir, de rapatrier ou d'ajouter des données, de sauvegarder ou non "La Base", et de la refermer.
Au final, "La Base" ne reste ouverte que qq millisecondes voire qq secondes (en fonction des traitements effectués) pour être à nouveau disponible pour un autre traitement provenenant du même ou d'un autre utilisateur.
Il arrive cependant qu'un 2eme processus veuille accéder à "La Base" alors que celle-ci est occupée.
Il s'agit donc de faire patienter qq secondes la 2ème demande, le temps que le premier traitement soit achevé et donc La Base refermée et donc à nouveau disponible 🙂
Le petit "plus" est que le Portail qui contient les macros peut être placé sur le réseau en Lecture-Seule. Ainsi tous les opérateurs peuvent l'ouvrir sur des PC différents car de toutes façons les données ne sont pas sur le Portail et que celui-ci se referme sans jamais enregistrer aucune modification 😉
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD
