[XL-2010] Modifier une ligne une fiche

**auggytiti** · 18/01/2018, 14h24

Bonjour,

Je sollicite votre aide

. je suis entrain de faire un fichier pour inscrire des patients et ensuite faire un suivi.
J'ai fais un VBA avec un formulaire Userform et le programme intègre une macro à l'exécution. en tout il y a deux Userform PATIENT et CONSULTATION.
Le création d'un patient (Bouton "PATIENT") se passe il créer la ligne et me créer un nouvel onglet avec le nom de l'ID c'est quand je fais appel au formulaire de CONSULTATION (bouton "NOUVELLE CONSULTATION") il me demande bien l'ID à Modifier mais me reporte pas les informations dans le formulaire et quand je l'exécute, il me créée bien un nouvelle onglet mais pas du tout au nom de l'ID.

J'avoue je sèche pour le coup.

Quelqu'un peut me fournir une aide?

voici le code pour enregistrer un patient celui là tout marche.

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
 
Private Sub CommandButton2_Click()
Unload PATIENT
End Sub
 
Private Sub naissance_Change()
    Dim Valeur As Byte
    naissance.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
    Valeur = Len(naissance)
    If Valeur = 2 Or Valeur = 5 Then naissance = naissance & "/"
End Sub
 
 
Private Sub nom_Change()
nom.Text = UCase(nom.Text)
End Sub
 
Private Sub prenom_Change()
prenom.Value = WorksheetFunction.Proper(prenom.Value)
End Sub
 
Private Sub tel_Change()
Dim Texte As String
Texte = tel.Text
Select Case Len(Texte)
Case 2, 5, 8, 11
Texte = Texte & " "
End Select
tel.Text = Texte
End Sub
 
Private Sub annuler_Click()
Unload Formulaire
 
End Sub
 
Private Sub CommandButton1_Click()
 
i = 1
Do While Cells(i, 1) <> ""
Cells(i, 1).Offset(1, 1).Select
i = i + 1
Loop
 
ActiveCell.Offset(0, 1).Value = PATIENT.nom.Value
ActiveCell.Offset(0, 2).Value = PATIENT.prenom.Value
ActiveCell.Offset(0, 3).Value = PATIENT.tel.Value
ActiveCell.Offset(0, 4).Value = PATIENT.mail.Value
ActiveCell.Offset(0, 5).Value = PATIENT.naissance.Value
ActiveCell.Offset(0, 7).Value = PATIENT.motif.Value
ActiveCell.Offset(0, 12).Value = PATIENT.digestif.Value
ActiveCell.Offset(0, 13).Value = PATIENT.circulatoire.Value
ActiveCell.Offset(0, 14).Value = PATIENT.osseux.Value
ActiveCell.Offset(0, 15).Value = PATIENT.nerveux.Value
ActiveCell.Offset(0, 16).Value = PATIENT.autres.Value
ActiveCell.Offset(0, 17).Value = PATIENT.symptomes.Value
ActiveCell.Offset(0, 18).Value = PATIENT.medicament.Value
 
 Application.ScreenUpdating = False
 'Application.OnTime Now + TimeValue("00:00:5"), "macro1"'
 
 'Application.OnTime Now + TimeValue("00:00:10"), "macro2"'
 
 Application.Run "Ajout"
 
Unload PATIENT
End Sub

je vous mets le code pour les Consultation que je n'arrive pas à comprendre pourquoi il ne fonctionne pas:

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
Private Sub UserForm_initialize()
Dim nomID As String
nomID = InputBox("ID à modifier", "Consultation Patient")
 
Application.DisplayAlerts = False
 Sheets(Array(nomID)).Select
 ActiveWindow.SelectedSheets.Delete
 Application.DisplayAlerts = True
CONSULTATION.id = nomID
Dim ligne As Integer
For ligne = 2 To 1000
    If Cells(ligne, 1) = nomID Then
    CONSULTATION.id = Cells(ligne, 1)
    CONSULTATION.nom = Cells(ligne, 3)
    CONSULTATION.prenom = Cells(ligne, 4)
    CONSULTATION.tel = Cells(ligne, 5)
    CONSULTATION.mail = Cells(ligne, 6)
    CONSULTATION.naissance = Cells(ligne, 7)
    CONSULTATION.motif = Cells(ligne, 9)
    CONSULTATION.rdv2 = Cells(ligne, 11)
    CONSULTATION.rdv3 = Cells(ligne, 12)
    CONSULTATION.rdv4 = Cells(ligne, 13)
    CONSULTATION.digestif = Cells(ligne, 14)
    CONSULTATION.circulatoire = Cells(ligne, 15)
    CONSULTATION.osseux = Cells(ligne, 16)
    CONSULTATION.nerveux = Cells(ligne, 17)
    CONSULTATION.autres = Cells(ligne, 18)
    CONSULTATION.symptomes = Cells(ligne, 19)
    CONSULTATION.medicament = Cells(ligne, 20)
    CONSULTATION.conseil2 = Cells(ligne, 21)
    CONSULTATION.obs2 = Cells(ligne, 22)
    CONSULTATION.conseil3 = Cells(ligne, 23)
    CONSULTATION.obs3 = Cells(ligne, 24)
    CONSULTATION.conseil4 = Cells(ligne, 25)
    CONSULTATION.obs4 = Cells(ligne, 26)
 
    End If
Next ligne
 
 
End Sub
 
Private Sub CommandButton1_Click()
Dim MODIFICATION As String
MODIFICATION = id.Value
With ThisWorkbook.Sheets("PATIENT")
    For i = Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("A" & i).Value = MODIFICATION Then
            Range("A" & i).Value = id.Value
            Range("C" & i).Value = nom.Value
            Range("D" & i).Value = prenom.Value
            Range("E" & i).Value = tel.Value
            Range("F" & i).Value = mail.Value
            Range("G" & i).Value = naissance.Value
            Range("I" & i).Value = motif.Value
            Range("K" & i).Value = rdv2.Value
            Range("L" & i).Value = rdv3.Value
            Range("M" & i).Value = rdv4.Value
            Range("N" & i).Value = digestif.Value
            Range("O" & i).Value = circulatoire.Value
            Range("P" & i).Value = osseux.Value
            Range("Q" & i).Value = nerveux.Value
            Range("R" & i).Value = autres.Value
            Range("S" & i).Value = symptomes.Value
            Range("T" & i).Value = medicament.Value
            Range("U" & i).Value = conseil2.Value
            Range("V" & i).Value = obs2.Value
            Range("W" & i).Value = conseil3.Value
            Range("X" & i).Value = obs3.Value
            Range("Y" & i).Value = conseil4.Value
            Range("Z" & i).Value = obs4.Value
 
        End If
    Next i
End With
 Application.ScreenUpdating = False
 'Application.OnTime Now + TimeValue("00:00:5"), "macro1"'
 
 'Application.OnTime Now + TimeValue("00:00:10"), "macro2"'
 
 Application.Run "Miseajour"
 
Unload CONSULTATION
End Sub
 
 
 
 
Private Sub CommandButton2_Click()
Unload CONSULTATION
End Sub
 
Private Sub naissance_Change()
    Dim Valeur As Byte
    naissance.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
    Valeur = Len(naissance)
    If Valeur = 2 Or Valeur = 5 Then naissance = naissance & "/"
End Sub
 
 
Private Sub nom_Change()
nom.Text = UCase(nom.Text)
End Sub
 
Private Sub prenom_Change()
prenom.Value = WorksheetFunction.Proper(prenom.Value)
End Sub
 
Private Sub rdv2_Change()
    Dim Valeur As Byte
    rdv2.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
    Valeur = Len(rdv2)
    If Valeur = 2 Or Valeur = 5 Then rdv2 = rdv2 & "/"
End Sub
 
Private Sub rdv3_Change()
    Dim Valeur As Byte
    rdv3.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
    Valeur = Len(rdv3)
    If Valeur = 2 Or Valeur = 5 Then rdv3 = rdv3 & "/"
End Sub
 
Private Sub rdv4_Change()
    Dim Valeur As Byte
    rdv4.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
    Valeur = Len(rdv4)
    If Valeur = 2 Or Valeur = 5 Then rdv4 = rdv4 & "/"
End Sub
 
Private Sub tel_Change()
Dim Texte As String
tel.MaxLength = 14
Texte = tel.Text
Select Case Len(Texte)
Case 2, 5, 8, 11
Texte = Texte & " "
End Select
tel.Text = Texte
End Sub

et une autre petite question ID je suis obligé de le noter avant dans la colonne sous forme "=GAUCHE($D1;1)&GAUCHE($C1;3)" est-il possible de l'intégrer au programme VBA?

Je mets le fichier pour que ça soit plus claire!!!
PATIENTS.xlsm
Merci encore!!

**mjpmjp** · 19/01/2018, 13h20

bonjour,

CONSULTATION.nom = Cells(ligne, 3)

tu dois indiquer où se trouve la cellule ...
Sheets(NomDeOnglet).Cells(ligne,3)

@+JP

**mjpmjp** · 19/01/2018, 13h44

bonjour,
pour la formule de ID :

Code :

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

1
2
3
4
5
6
7
8
 
Private Sub CommandButton1_Click()
NumLigne = 3
Range("a" & NumLigne).FormulaLocal = "= GAUCHE($D" & NumLigne & ";1)" & Chr(38) & " GAUCHE($C" & NumLigne & ";3)"
 
Range("a" & NumLigne).Value = "=D" & NumLigne & Chr(38) & "C" & NumLigne
 
End Sub

la ligne : Range("a" & NumLigne).FormulaLocal
reconstruit la formule d'origine en intégrant le numéro de ligne

la ligne : Range("a" & NumLigne).Value
invente une nouvelle formule plus simple ( même résultat )

pour info : Chr(38) correspond au caractère " & "

@+JP

[XL-2010] Modifier une ligne une fiche

Macros et VBA Excel

Discussions similaires

Partager

Partager