Si aucune modification sur DatePicker then

Version imprimable

Voir 40 message(s) de cette discussion en une page

Insomnie oblige, je me suis permis d'ouvrir le fichier et fais des réajustements:
Il s'agit de chercher une ligne à l'aide de #DPP, de modifier et de remplacer les anciennes données
sinon, si les modifications seraient re enregistrées à la fin, des petits réajustements seront nécessaires.
1. J'ai ajouté un module public au projet

Code:

1
2
3
Option Explicit
Public ValCher As String  '#DDP à modifier
Public LigModif As Long  'La ligne correspondante

2. J'ai modifié tes procédures et supprimé certaines inutiles

Code:

1
2
3
4
5
6
7
8
9
10
11
Option Explicit
'Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)  'gardé pour imprimer l'usf
 
Private Sub cbxJustification_Change()
    tbxAutreJustif.Visible = (cbxJustification.Value = "Autre :")
    cbxRetourInvest.Visible = (cbxJustification.Value <> "N/A")
    tbxExempleJustif.Visible = (cbxJustification.Value <> "N/A")
    tbxAutreJustif.Visible = (cbxJustification.Value <> "N/A")
    Label43.Visible = (cbxJustification.Value <> "N/A")
    Label44.Visible = (cbxJustification.Value <> "N/A")
End Sub

Code:

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
Private Sub cbxNoDDP_Change()
Dim plage As Range, c As Range
 
ValCher = cbxNoDDP.Value
Set plage = Sheets("Liste Demande de projet").Range("A3:A500")
Set c = plage.Find(ValCher, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
    LigModif = c.Row
    tbxInitiateur.Value = c.Offset(0, 1).Value
    tbxTitre.Value = c.Offset(0, 3).Value
    tbxObjectifs.Value = c.Offset(0, 4).Value
    tbxNoDAC.Value = c.Offset(0, 5).Value
    cbxAtelier.Value = c.Offset(0, 6).Value
    tbxSitAct.Value = c.Offset(0, 7).Value
    tbxSolution.Value = c.Offset(0, 8).Value
    tbxSommaireCouts.Value = c.Offset(0, 9).Value
    tbxEcheancier.Value = c.Offset(0, 10).Value
    cbxJustification.Value = c.Offset(0, 11).Value
    tbxAutreJustif.Value = c.Offset(0, 12).Value
    cbxRetourInvest.Value = c.Offset(0, 13).Value
    tbxExempleJustif.Value = c.Offset(0, 14).Value
    tbxCommentairesChefIng.Value = c.Offset(0, 17).Value
    cbxStatut.Value = c.Offset(0, 18).Value
    cbxType.Value = c.Offset(0, 19).Value
    cbxPriorite.Value = c.Offset(0, 20).Value
    tbxCommentaires.Value = c.Offset(0, 21).Value
 
    DTPDemande.Value = IIf(c.Offset(0, 2).Value = "", Date, c.Offset(0, 2).Value)
    MultiPage1.Value = 3
    DTPSignChef.Value = IIf(c.Offset(0, 15).Value = "", Date, c.Offset(0, 15).Value)
    DTPSignDir.Value = IIf(c.Offset(0, 16).Value = "", Date, c.Offset(0, 16).Value)
    MultiPage1.Value = 0
End If
End Sub

Code:

1
2
3
Private Sub btAnnuler_Click()
    Unload frmModifDDP
End Sub

Code:

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
Private Sub btOK_Click()
Dim FeuilSuivi As Worksheet
Dim Rep As String
 
Set FeuilSuivi = Sheets("Liste Demande de projet")
With FeuilSuivi
    .Cells(LigModif, 2).Value = tbxInitiateur.Value
    .Cells(LigModif, 3).Value = DTPDemande.Value
    .Cells(LigModif, 4).Value = tbxTitre.Value
    .Cells(LigModif, 5).Value = tbxObjectifs.Value
    .Cells(LigModif, 6).Value = tbxNoDAC.Value
    .Cells(LigModif, 7).Value = cbxAtelier.Value
    .Cells(LigModif, 8).Value = tbxSitAct.Value
    .Cells(LigModif, 9).Value = tbxSolution.Value
    .Cells(LigModif, 10).Value = tbxSommaireCouts.Value
    .Cells(LigModif, 11).Value = tbxEcheancier.Value
    .Cells(LigModif, 12).Value = cbxJustification.Value
    .Cells(LigModif, 13).Value = tbxAutreJustif.Value
    .Cells(LigModif, 14).Value = cbxRetourInvest.Value
    .Cells(LigModif, 15).Value = tbxExempleJustif.Value
    .Cells(LigModif, 16).Value = IIf(Date = DTPSignChef.Value, "", DTPSignChef.Value)
    .Cells(LigModif, 17).Value = IIf(Date = DTPSignDir.Value, "", DTPSignDir.Value)
    .Cells(LigModif, 18).Value = tbxCommentairesChefIng.Value
    .Cells(LigModif, 19).Value = cbxStatut.Value
    .Cells(LigModif, 20).Value = cbxType.Value
    .Cells(LigModif, 21).Value = cbxPriorite.Value
    .Cells(LigModif, 22).Value = tbxCommentaires.Value
    .Cells(LigModif, 23).Value = tbxPart2Ress.Value
    .Cells(LigModif, 24).Value = tbxPart3Ress.Value
 
    Unload frmModifDDP
 
    Rep = MsgBox("Voulez-vous modifier une autre demande de projet", vbYesNo + vbQuestion, "Autre demande de projet")
    If Rep = vbNo Then
        Application.ScreenUpdating = False
        .Cells.EntireColumn.AutoFit
        Application.ScreenUpdating = True
    Else
        Load frmNoDDPModif
        frmNoDDPModif.Show
    End If
End With
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub UserForm_Initialize()
 
' Définition des listes
cbxAtelier.RowSource = "Feuil1!A1:A34"
cbxJustification.RowSource = "Feuil1!B1:B6"
cbxRetourInvest.RowSource = "Feuil1!C1:C4"
cbxNoDDP.RowSource = "Feuil1!D1:D500"
cbxStatut.AddItem "Accepté"
cbxStatut.AddItem "Refusé"
cbxType.AddItem "Capital"
cbxType.AddItem "Expense"
cbxPriorite.AddItem "1"
cbxPriorite.AddItem "2"
cbxPriorite.AddItem "3"
cbxPriorite.AddItem "4"
 
cbxNoDDP.Value = ValCher
End Sub

3. Pour l'userform frmNoDDPModif

Code:

1
2
3
4
5
6
7
8
9
10
Private Sub CommandButton1_Click()
ValCher = cbxNoDDP2.Value
frmNoDDPModif.Hide
Load frmModifDDP
frmModifDDP.Show
End Sub
 
Private Sub UserForm_Initialize()
cbxNoDDP2.RowSource = "Feuil1!D1:D500"
End Sub

Il reste une question incompréhensible concernant les dates à reporter sur ta feuille.
J'espère que tu arrive à cerner ton projet avant de te lancer par des tâtonnements fastidieux et qui rendent le code et le but illisibles.
Bon courage

Bonjour!

Merci pour l'énergie que tu apportes à mon problème et désolée de ne pas t'avoir répondu plus tot.

J'ai testé dans un fichier test avec seulement tes codes et ça fonctionne en partie...
Voici les problèmes qui restent:

le numéro DDP (qui est dans la variable ValCher) ne va pas s'inscrire dans mon formulaire, donc la macro Private Sub cbxNoDDP_Change() ne s'effectue pas (puisque chxNoDDP n'est pas modifié.

Aussi, si je choisi moi même un numéro une fois rendue dans mon formulaire, les tbx et cbx sont bien remplies avec les bonnes données. Parcontre, si la valeur de la cellule recherchée est vide les DTP renvoie la date 1899-12-30... pourquoi?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub UserForm_Initialize()
 
' Définition des listes
cbxAtelier.RowSource = "Feuil1!A1:A34"
cbxJustification.RowSource = "Feuil1!B1:B6"
cbxRetourInvest.RowSource = "Feuil1!C1:C4"
cbxNoDDP.RowSource = "Feuil1!D1:D500"
cbxStatut.AddItem "Accepté"
cbxStatut.AddItem "Refusé"
cbxType.AddItem "Capital"
cbxType.AddItem "Expense"
cbxPriorite.AddItem "1"
cbxPriorite.AddItem "2"
cbxPriorite.AddItem "3"
cbxPriorite.AddItem "4"
 
cbxNoDDP.Value = ValCher
End Sub

Code:

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
Private Sub cbxNoDDP_Change()
Dim plage As Range, c As Range
 
ValCher = cbxNoDDP.Value
Set plage = Sheets("Liste Demande de projet").Range("A3:A500")
Set c = plage.Find(ValCher, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
    LigModif = c.Row
    tbxInitiateur.Value = c.Offset(0, 1).Value
    tbxTitre.Value = c.Offset(0, 3).Value
    tbxObjectifs.Value = c.Offset(0, 4).Value
    tbxNoDAC.Value = c.Offset(0, 5).Value
    cbxAtelier.Value = c.Offset(0, 6).Value
    tbxSitAct.Value = c.Offset(0, 7).Value
    tbxSolution.Value = c.Offset(0, 8).Value
    tbxSommaireCouts.Value = c.Offset(0, 9).Value
    tbxEcheancier.Value = c.Offset(0, 10).Value
    cbxJustification.Value = c.Offset(0, 11).Value
    tbxAutreJustif.Value = c.Offset(0, 12).Value
    cbxRetourInvest.Value = c.Offset(0, 13).Value
    tbxExempleJustif.Value = c.Offset(0, 14).Value
    tbxCommentairesChefIng.Value = c.Offset(0, 17).Value
    cbxStatut.Value = c.Offset(0, 18).Value
    cbxType.Value = c.Offset(0, 19).Value
    cbxPriorite.Value = c.Offset(0, 20).Value
    tbxCommentaires.Value = c.Offset(0, 21).Value
 
    DTPDemande.Value = IIf(c.Offset(0, 2).Value = "", Date, c.Offset(0, 2).Value)
    MultiPage1.Value = 3
    DTPSignChef.Value = IIf(c.Offset(0, 15).Value = "", Date, c.Offset(0, 15).Value)
    DTPSignDir.Value = IIf(c.Offset(0, 16).Value = "", Date, c.Offset(0, 16).Value)
    MultiPage1.Value = 0
End If
End Sub

Merci encore!!!
Geneviève :lol:

24/11/2009, 20h52
mercatog

Fichier joint

Malheureusement, je n'ai plus ton fichier test;
mais je ne vois pas de problème;
surement tu as oublié quelque chose
si tu re mets ton fichier

Edit: Bon voilà, j'ai restauré ma corbeille, ci joint le fichier
j'attends tes tests!

Bonjour,

Je vien de tester ton fichier et effectivement, le NoDDP se transfère bien. Parcontre, le problème des date picker reste là... si j'effecute les étapes suivantes:

Ajout d'une nouvelle demande
Je complète l'onglet 1 seulement (donc les DTP de l'onglet 3 ne sont pas activé)
Je click sur OK pour transférer mes données dans ma feuille
Les données de dates renvoyées dans la feuille pour les DTP de l'onglet 3 est 1900-01-00
Je click sur mon bouton "Modifier demande" et que je choisi la demande que je vien de créer
J'active l'onglet 3

j'obtiens comme date dans mes DTP 1899-12-30 (soit 1 jour de moins que ce qui est inscrit dans ma feuille 1900-01-00)...
Je ne comprend pas pourquoi ça fait ça.... j'ai testé au bureau et à la maison et j'obtiens le même résultat...

J'ai essayé de modifier le code comme suit, mais sans succès :
Code:

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 Private Sub cbxNoDDP_Change() Dim plage As Range, c As Range ValCher = cbxNoDDP.Value Set plage = Sheets("Liste Demande de projet").Range("A3:A500") Set c = plage.Find(ValCher, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then LigModif = c.Row tbxInitiateur.Value = c.Offset(0, 1).Value tbxTitre.Value = c.Offset(0, 3).Value tbxObjectifs.Value = c.Offset(0, 4).Value tbxNoDAC.Value = c.Offset(0, 5).Value cbxAtelier.Value = c.Offset(0, 6).Value tbxSitAct.Value = c.Offset(0, 7).Value tbxSolution.Value = c.Offset(0, 8).Value tbxSommaireCouts.Value = c.Offset(0, 9).Value tbxEcheancier.Value = c.Offset(0, 10).Value cbxJustification.Value = c.Offset(0, 11).Value tbxAutreJustif.Value = c.Offset(0, 12).Value cbxRetourInvest.Value = c.Offset(0, 13).Value tbxExempleJustif.Value = c.Offset(0, 14).Value tbxCommentairesChefIng.Value = c.Offset(0, 17).Value cbxStatut.Value = c.Offset(0, 18).Value cbxType.Value = c.Offset(0, 19).Value cbxPriorite.Value = c.Offset(0, 20).Value tbxCommentaires.Value = c.Offset(0, 21).Value DTPDemande.Value = IIf(c.Offset(0, 2).Value = "1900-01-00", Date, c.Offset(0, 2).Value) MultiPage1.Value = 3 DTPSignChef.Value = IIf(c.Offset(0, 15).Value = "1900-01-00", Date, c.Offset(0, 15).Value) DTPSignDir.Value = IIf(c.Offset(0, 16).Value = "1900-01-00", Date, c.Offset(0, 16).Value) MultiPage1.Value = 0 End If End Sub
Est-ce une configuration de mon Excel ou est-ce vraiment un problème de programmation?

Merci encore!
Geneviève

Ton probleme vient du code btnOK de ton usf frmPostMortem
essaies de changer les lignes concernées comme ceci
Code:

1 2 3 4 5 6 FeuilSuivi.Cells(derlig, 15).Value = tbxExempleJustif.Value FeuilSuivi.Cells(derlig, 16).Value = IIf(date2 <> Date, "", date2) FeuilSuivi.Cells(derlig, 17).Value = IIf(date3 <> Date, "", date3) FeuilSuivi.Cells(derlig, 18).Value = tbxCommentairesChefIng.Value
(au lieu d'affecter 0interpréte 00/01/1900 par le formatage en date de la colonne, on mets du vide)

Voir 40 message(s) de cette discussion en une page