Classeur partagé - conflit à l'enregistrement
Bonjour à tous,
J'ai créé un outil qui permet aux collaborateurs de ma boite d'effectuer un vote sur des thèmes à choisir (dans le cadre de formation continue)...
L'utilisateur rendre dans excel, active les macros et donc le classeur partagé, puis navigue sur différentes feuilles pour répondre par oui/non à des choix différents.
Ces choix sont centralisés sur une feuille qui copie (cellules liées) les résultats. (Feuille : OUTPUT_ANGABE)
Ma macro si dessous enregistre dans un Banque de données (BD) les résultats de tous les utilisateurs.
Ces choix s'inscrivent en dernière ligne du tableau BD.
Voilà la macro :
Sub Valider2()
Sheets("Wait").Activate
UsF_Wait.Show 0
Application.ScreenUpdating = False
Application.Wait Time + TimeSerial(0, 0, 2)
'Sheets("OUTPUT_Angaben").Activate
With Sheets("OUTPUT_Angaben").Range("B1:B100")
.Copy
Application.ScreenUpdating = False
Sheets("BD").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End With
Application.ScreenUpdating = False
ActiveWorkbook.Save
Application.ScreenUpdating = False
Sheets("ThankYou").Activate
ActiveWorkbook.Save
'UsF_AuswahlGespeichert.Show 0
Application.ScreenUpdating = True
Unload UsF_Wait
End Sub
Mon problème est le suivant :
Comme le fichier est partagé, le repère de la dernière ligne est conflictuelle si un autre utilisateur se trouve également dans le fichier. La dernière ligne peut donc être plusieurs fois la ligne 30 pour la macro...
Un solution pour m'éviter d'avoir des doublons ?
D'avance merci pour vos aides précieuses
Willau
- Messages
- 4'100
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour,
ci-dessous exemple de code pour gérer un conflit de mise à jour :
Sub Valider2()
Dim fso As Object, attente_max As Date, date_fin As Date
Dim fichier_verrou As String: fichier_verrou = ThisWorkbook.Path & "\lock.csv"
Application.ScreenUpdating = False
'asignation objet Filesystem
Set fso = CreateObject("Scripting.FileSystemObject")
'suppression éventuelle du verrou si ce classeur n'est pas ouvert par un autre utilisateur
With ThisWorkbook
If UBound(.UserStatus) = 1 Then If fso.FileExists(fichier_verrou) Then fso.GetFile(fichier_verrou).Delete
End With
'..... contrôle accès en maj du classeur sinon attente 2 secondes ...........................................
attente_max = Timer + 60 'attente maximum = 60 secondes
While fso.FileExists(fichier_verrou)
If Timer > attente_max Then MsgBox "temps d'attente dépassé": Exit Sub
date_fin = DateAdd("s", 2, Now)
Application.Wait date_fin
Wend
'----- création fichier verrou
fso.CreateTextFile fichier_verrou
'----- exécution des mises à jour
ActiveWorkbook.Save
With Sheets("OUTPUT_Angaben").Range("B1:B100")
.Copy
Sheets("BD").Columns("A").Find("").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End With
ActiveWorkbook.Save
'----- fin exécution des mises à jour
'----- suppression fichier verrou
fso.GetFile(fichier_verrou).Delete
End Sub