Discussion :

[lafafmentvotre]

Bonsoir

Petit prob que j'arrives pas à résoudre.
J'ai une textbox alimentée par userform calendrier.

1. quand je clic, que le userform s'ouvre et que je le ferme sans sélectionner une date, le textbox est rempli (pas logique)
2. et c'est ce prob qui me saoule, lorsque j'enregistre mon fichier les valeurs de mon textbox s'effacent.

Auriez-vous une idée pour m'aider ?

Voici le code propre à mon textbox :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub cont_arrivee_gotFocus()
UserForm1.Show
cont_arrivee = Format(UserForm1.Calendar1.Value, "ddd dd mmm yyyy")
If cont_arrivee = "" Then
Sheets("INFORMATIQUE").Rows(17).EntireRow.Hidden = True
Sheets("INFORMATIQUE").Range("A17") = ""
Else
Sheets("INFORMATIQUE").Rows(17).EntireRow.Hidden = False
Sheets("INFORMATIQUE").Range("A17") = "Arrivée le : " & cont_arrivee
End If
End Sub

et le code calendar dans le userform :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub Calendar1_Click()
Hide
End Sub
Private Sub UserForm_Initialize()
Calendar1.Value = ""
Calendar1.Value = Date
End Sub

merci par avance

[allergique]

Bonsoir,

Pour ton problème "1":

C'est normal que le textbox soit rempli puisqu'à l'ouverture du calendar tu lui attribues la date du jour donc sa valeur ne sera jamais nulle...

Pour contourner ce problème tu peux déclarer une variable boolean qui passe à true quand tu cliques sur le calendrier, ce qui signifie que tu as mis "volontairement" une date.

Il suffit juste d'ajouter if tavariable=true then....cont_arrivee = Format(UserForm1.Calendar1.Value, "ddd dd mmm yyyy")

Problème 2, tout reste dans le textbox chez moi

[lafafmentvotre]

Bonjour

Merci pour tes réponses.

Aurais-tu un exemple pour la variable boolean et me dire où je dois la placer ?

Pour le point 2, j'ai testé sur plusieurs ordinateurs et le prob est le même.
Je ne comprends pas

[allergique]

Bonjour,

Pour rester simple et éviter de faire cette programmation, est-ce qu'il n'est pas possible de retirer la ligne "Calendar1.Value = Date" quand tu initialises l'userform?

Si c'est pas possible tu trouveras ci-dessous un exemple

Dans le textbox:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub cont_arrivee_GotFocus()
test = False
UserForm1.Show
If test = True Then
    cont_arrivee = Format(UserForm1.Calendar1.Value, "ddd dd mmm yyyy")
End If
If cont_arrivee = "" Then
Sheets("INFORMATIQUE").Rows(17).EntireRow.Hidden = True
Sheets("INFORMATIQUE").Range("A17") = ""
Else
Sheets("INFORMATIQUE").Rows(17).EntireRow.Hidden = False
Sheets("INFORMATIQUE").Range("A17") = "Arrivée le : " & cont_arrivee
End If
End Sub

Dans l'userform:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub Calendar1_Click()
test = True
Hide
End Sub
Private Sub UserForm_Initialize()
Calendar1.Value = ""
Calendar1.Value = Date
 
End Sub

Dans un module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Public test As Boolean

[lafafmentvotre]

Hello

Cela fonctionne, super.

Par contre le point 2 ne change pas, ma textbox avec la date ainsi qu'une autre est vidée à l'enregistrement.
Ce qui est bizarre, c'est que le contenu s'efface lorsque j'enregistre sous un autre nom ou que j'utilise le module ci-dessous. Le prob n'est pas rencontré lorsque j'enregistre le doc sous le même nom
Ne serais-ce pas une propriété de textbox qui changerait vis à vis des autres (celles qui ne s'effacent pas).

Voici le module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Sub Save_Mvt()
On Error Resume Next
Dim Message_Alerte As String
Dim temp_Name As String
Dim temp_Path As String
Dim name As String
Dim file As Object
Dim newhour As String
Dim newMinute As String
Dim newSecond As String
Dim waitTime As String
Dim fs As Scripting.FileSystemObject
Set fs = New Scripting.FileSystemObject
col_nom = ActiveWorkbook.Worksheets("Demande").col_nom
col_prenom = ActiveWorkbook.Worksheets("Demande").col_prenom
cont_mouvement = ActiveWorkbook.Worksheets("Demande").cont_mouvement
cont_contrat = ActiveWorkbook.Worksheets("Demande").cont_contrat
cont_arrivee = ActiveWorkbook.Worksheets("Demande").cont_arrivee
If col_nom = "" Then Message_Alerte = "- Nom Collaborateur" & vbCrLf
If col_prenom = "" Then Message_Alerte = Message_Alerte & "- Prénom Collaborateur" & vbCrLf
If cont_mouvement = "" Then Message_Alerte = Message_Alerte & "- Type mouvement" & vbCrLf
If cont_mouvement = "Arrivée" And cont_contrat = "" Then Message_Alerte = Message_Alerte & "- Type contrat" & vbCrLf
If Message_Alerte <> "" Then
MsgBox "Les champs suivants sont obligatoires." & vbLf & "Merci de les renseigner avant de cliquer sur Save_Mvt." & vbLf & vbLf & "Merci" & vbLf & vbLf & Message_Alerte
Else
name = cont_mouvement & "_" & col_prenom & "." & col_nom
temp_Name = Left(name, Len(name)) & Format(Date, "_yyyymmdd") & ".xls"
temp_Path = "N:\LMCMD\InfrastructureFrance_Support\Base-Mvt-Personnel\Demandes\"
 
If Not fs.FolderExists(temp_Path) Then
MsgBox ("Chemin inexistant:" _
& vbCrLf & temp_Path _
& vbCrLf & vbCrLf & "La sauvegarde ne peut aboutir"), vbCritical, "Erreur d'accès réseau..."
Exit Sub
Else
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=temp_Path & temp_Name
Application.DisplayAlerts = True
MsgBox "Fichier renommé et sauvegardé dans :" & vbLf & temp_Path & vbLf & vbLf & "Le fichier va se fermer"
newhour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 3
waitTime = TimeSerial(newhour, newMinute, newSecond)
Application.Wait waitTime
ActiveWorkbook.Close
End If
End If
End Sub