Partage d'un fichier Excel contenant du VBA

CG15

XLDnaute Nouveau
Bonsoir,
J'ai créé une petite base de données grace aux conseils et exemples de ce site et je vous en remercie;).
Avant de publier "mon travail" sur ce site et en faire profiter d'autres, je souhaite résoudre un problème de partage de cette base de données sur le réseau.
Le principe est le suivant: nous sommes 10 à travailler en même temps face à des clients. Nous les enregistrons (création et modification) avec : nom / prénom / date de naissance / date de la visite initiale / date dernière visite / numéro de dossier.

Le userform fonctionne très bien si on travaille sur un fichier non partagé; il va me chercher la première ligne vide et la remplit avec les infos du userform.
Mais, en mode partagé, le rythme de rafraichissement du fichier ( 5 minutes mini) est trop lent; mon collègue peut vouloir enregistrer sur la même ligne un nouveau client et un conflit apparaît avec une perte de données inévitable.
J'ai essayé un enregistrement à chaque validation mais aucune avancée. Comment faire pour réserver une ligne dès que l'utilisateur lance le userform ???
ou, comment faire pour qu'à chaque fois que le userform est lancé Excel rafraichit le fichier ???
Quelles solutions me conseillez-vous ? et Excel est-il bien fait pour cela ??

PS: j'ai oublié de vous dire que je n'utilise VBA pour Excel que depuis deux mois:eek:
La preuve, voici le code du userform:

Option Explicit
Const strAppName = "Saisie des clients"
Dim bNouveau As Boolean
Private Sub ComboBox1_click()
Dim i As Integer
Dim j As Integer
bNouveau = False
i = ComboBox1.ListIndex + 2
With ThisWorkbook.Worksheets("liste")
Listing.txtNom = .Cells(i, 3)
Listing.txtPrenom = .Cells(i, 4)
Listing.txtDate_de_naissance = .Cells(i, 5)
End With
End Sub

Private Sub affiche_ComboBox1()
Dim rng As Range
Dim ligne As Range
With ThisWorkbook.Worksheets("liste")
.Activate
Set rng = .Range("A1").CurrentRegion
Set rng = .Range("C2:H" & rng.Rows.Count + 1)
ComboBox1.Clear
For Each ligne In rng.Rows
If Cells(ligne.row, 3) <> "" Then
lliste.AddItem Cells(ligne.row, 3) & " " & _
Cells(ligne.row, 4) & " " & _
Cells(ligne.row, 5)
Else
Exit For
End If
Next ligne
End With
End Sub

Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Dim rng As Range
Dim cell As Range
Affiche_listing
lliste.ListIndex = 0
bNouveau = True
End Sub

Private Sub Affiche_listing()
Dim NbJOuvr As Byte
Dim rng As Range
Dim ligne As Range
With ThisWorkbook.Worksheets("Liste")
.Activate
Set rng = .Range("A1").CurrentRegion
Set rng = .Range("C2:H" & rng.Rows.Count + 3)
lliste.Clear
For Each ligne In rng.Rows
If Cells(ligne.row, 3) <> "" Then
lliste.AddItem Cells(ligne.row, 3) & " " & _
Cells(ligne.row, 4) & " " & _
Cells(ligne.row, 5)
Else
Exit For
End If
Next ligne
End With
Dim i As Integer
Dim j As Integer
i = 1
With ThisWorkbook.Worksheets("liste")
Listing.Datedujour = .Cells(i, 17)
End With
NbJOuvr = VBA.Format(Now, "dd")
txtDate_de_la_dernière_visite = VBA.Format(Now, "dd/mm/yyyy")
Debug.Print txtDate_de_la_dernière_visite
Datedujour = VBA.Format(Now, "dd/mm/yyyy")
Debug.Print Datedujour
NbJOuvr = CDate(Datedujour) - CDate(txtDate_de_la_dernière_visite)
End Sub

Private Sub cmdfermer_Click()
If MsgBox("Voulez-vous mettre un terme à la saisie ?", _
vbQuestion + vbYesNo, strAppName) = vbYes Then
Unload Me
Sheets("DOMI").Select
Application.ScreenUpdating = True
End If
End Sub

Private Sub cmdNouveau_Click()
init_listing
bNouveau = True
End Sub

Private Sub cmdValider_click()
Dim rng As Range
Dim i As Long
If txtPrenom = "" Or txtNom = "" _
Then
MsgBox "Civilité Nom Prenom/ Date de naissance/ Num_dossier / Date de la visite initiale/ Date de la dernière visite/ sont obligatoires. Corrigez votre saisie", vbExclamation, strAppName
txtNom.SetFocus
Exit Sub
End If
If Not (optMonsieur Or optMadame Or optMelle) Then
MsgBox "Civilité obligatoire", vbExclamation, strAppName
optMonsieur.SetFocus
Exit Sub
End If
With ThisWorkbook.Worksheets("liste")
If bNouveau Then
ActiveCell.End(xlDown).Select
Set rng = .Range("C2").CurrentRegion
i = rng.Rows.Count + 1
Else
i = lliste.ListIndex + 2
End If
If optMonsieur Then
.Cells(i, 2) = "Monsieur"
ElseIf optMadame Then
.Cells(i, 2) = "Madame"
Else
.Cells(i, 2) = "Mademoiselle"
End If
.Cells(i, 3) = Listing.txtNom
.Cells(i, 4) = Listing.txtPrenom
.Cells(i, 5) = Listing.txtDate_de_naissance
.Cells(i, 7) = Listing.txtDate_de_la_demande_initiale
.Cells(i, 8) = Listing.txtDate_de_la_dernière_visite
End With
If bNouveau Then Affiche_listing
init_listing
Application.AlertBeforeOverwriting = False
With ThisWorkbook.Worksheets("liste")
End With
End Sub

Private Sub init_listing()
Dim i As Integer
With Listing
txtNom = ""
txtPrenom = ""
txtDate_de_naissance = ""
txtDate_de_la_visite_initiale = ""
txtDate_de_la_dernière_visite = ""
optMonsieur = False
optMadame = False
optMelle = False
For i = 0 To lliste.ListCount - 1
lliste.Selected(i) = False
Next i
End With
End Sub

Private Sub txtDate_de_naissance_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(Me.txtDate_de_naissance) Then
MsgBox "Erreur saisie! Il doit s'agir d'une date(format ''dd/mm/yy''); cliquer sur ''ok'' pour revenir au formulaire puis sur ''Echap'' pour sortir du champ ''date de naissance''", _
vbQuestion, strAppName
Cancel = True
Me.txtDate_de_naissance = VBA.Format("dd/mm/yyyy")
End If
End Sub

Private Sub txtDate_de_la_demande_initiale_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(Me.txtDate_de_la_demande_initiale) Then
MsgBox "Erreur saisie! Il doit s'agir d'une date (format ''dd/mm/yy''); cliquer sur ''ok'' pour revenir au formulaire puis sur ''Echap'' pour sortir du champ ''Date_de_la_demande_initiale''", _
vbQuestion, strAppName
Cancel = True
Me.txtDate_de_la_demande_initiale = VBA.Format("dd/mm/yyyy")
End If
End Sub

Private Sub txtDate_de_la_dernière_visite_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(Me.txtDate_de_la_dernière_visite) Then
MsgBox "Erreur saisie! Il doit s'agir d'une date(format ''dd/mm/yy''); cliquer sur ''ok'' pour revenir au formulaire puis sur ''Echap'' pour sortir du champ ''Date_de_la_dernière_visite''", _
vbQuestion, strAppName
Cancel = True
Me.txtDate_de_la_dernière_visite = VBA.Format("dd/mm/yyyy")
End If
End Sub
 
Dernière édition:

Discussions similaires

Réponses
6
Affichages
202
Réponses
1
Affichages
119
Réponses
5
Affichages
124