Discussion :

[guy59960]

Bonjour à tous,

Novice dans VBA pour excel, je suis amené à réaliser de très simples développements (au demeurant souvent par mimétisme) et je commence à être confronté à la problématique des lignes de codes qui se répètent. Un exemple vaut mieux que de longs discours c'est pourquoi, je me permets de vous en soumettre un.

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
Private Sub CmbValiderLabel1_Click()
 
 
If Me.CheckBox1.Value = True And Me.CheckBoxDoc1.Value = False And TextBox21.Value = "" Then
MsgBox ("Vous devez indiquer pourquoi la pièce n'est pas archivée - à moins que vous n'ayez omis de cocher la case document archivé")
TextBox21.Visible = True
TextBox21.SetFocus
Else
MsgBox ("c'est ok")
End If
msg = "voulez-vous archiver des pièces de même nature ?"
style = vbYesNo
title = "archivage de  " & Me.Label1.Caption
response = MsgBox(msg, style, title)
If response = vbNo Then
routineCacher1
Else
 
Exit Sub
End If
Sheets("table1").Select
Range("d3").Value = "oui"
End Sub
 
Private Sub CmbValiderLabel10_Click()
 
If Me.CheckBox10.Value = True And Me.CheckBoxDoc10.Value = False And TextBox30.Value = "" Then
MsgBox ("Vous devez indiquer pourquoi la pièce n'est pas archivée - à moins que vous n'ayez omis de cocher la case document archivé")
TextBox30.Visible = True
TextBox30.SetFocus
Else
MsgBox ("c'est ok")
End If
msg = "voulez-vous archiver des pièces de même nature ?"
style = vbYesNo
title = "archivage de  " & Me.Label1.Caption
response = MsgBox(msg, style, title)
If response = vbNo Then
routineCacher10
Else
 
Exit Sub
End If
variable10 = 1
Sheets("table1").Select
Range("d12").Value = "oui"
 
End Sub
 
Private Sub CmbValiderLabel11_Click()
 
If Me.CheckBox11.Value = True And Me.CheckBoxDoc11.Value = False And TextBox31.Value = "" Then
MsgBox ("Vous devez indiquer pourquoi la pièce n'est pas archivée - à moins que vous n'ayez omis de cocher la case document archivé")
TextBox31.Visible = True
TextBox31.SetFocus
Else
MsgBox ("c'est ok")
'Exit Sub
End If
msg = "voulez-vous archiver des pièces de même nature ?"
style = vbYesNo
title = "archivage de  " & Me.Label1.Caption
response = MsgBox(msg, style, title)
If response = vbNo Then
routineCacher11
Else
 
Exit Sub
End If
 
Sheets("table1").Select
Range("d13").Value = "oui"
 
End Sub

Naturellement quelques explications s'imposent :

Pour l'archivage de documents techniques dans la construction de bâtiments, l'archiviste a renseigné dans l'onglet "table1" son référenciel de documents :
en colonne B précise le nom et la codification des documents
en colonne C indique si le document doit être obligatoirement fourni ("oui")
en colonne D durant l'archivage proprement dit il sera indiqué si la pièce est ou non archivée, ce qui permettra au terme de l'archivage de solliciter le technicien pour lui demander pourquoi l'archive quoi qu’obligatoire n'a pas été versée (et ce par le biais d'un input box ).

Je reste persuadé que mes lignes de codes peuvent être simplifiées.

Remerciant la personne qui prendra le temps de m'aider tout en m'apportant le maximum d'explications.

Cordialement

Guy59960

[helas]

Bonjour,
La solution serait l'appel d'une fonction, ici nommé Archivage
Cette solution implique que les noms des objets possèdent le même suffixe :CheckBox1, CheckBoxDoc1 et peut être même TextBox1

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
 
Private Sub CmbValiderLabel1_Click()
  If Archivage(1)= vbNo Then   routineCacher1 Else   Exit Sub
  Sheets("table1").Select
  Range("d3").Value = "oui"
End Sub
 
Private Sub CmbValiderLabel10_Click()
  If Archivage(10) = vbNo Then routineCacher10 Else  Exit Sub
  variable10 = 1 
  Sheets("table1").Select
  Range("d12").Value = "oui"
End Sub
 
Private Sub CmbValiderLabel11_Click()
 If Archivage(11) = vbNo Then    routineCacher11  Else   Exit Sub
 Sheets("table1").Select 
 Range("d13").Value = "oui"
End Sub
 
Function Archivage(n as integer) as long
  If Me(CheckBox & cstr(n)).Value = True And Me(CheckBoxDoc & cstr(n)).Value = False And TextBox30.Value = "" Then
     MsgBox ("Vous devez indiquer pourquoi la pièce n'est pas archivée - à moins que vous n'ayez omis de cocher la case document archivé")
    TextBox30.Visible = True
    TextBox30.SetFocus
  Else 
   MsgBox ("c'est ok")
  End If
  msg = "voulez-vous archiver des pièces de même nature ?"
  style = vbYesNo
  title = "archivage de  " & Me!Label1.Caption
  Archivage = MsgBox(msg, style, title)
End Function

ou même passer un deuxième paramètre pour le TextBox

Code :

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

1
2
 
If Archivage(11,30) = vbNo Then

avec la modification de la fonction

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Function Archivage(n as integer, k as integer) as long
  If Me(CheckBox & cstr(n)).Value = True And Me(CheckBoxDoc & cstr(n)).Value = False And Me(TextBox & cstr(k)).Value = "" Then
     MsgBox ("Vous devez indiquer pourquoi la pièce n'est pas archivée - à moins que vous n'ayez omis de cocher la case document archivé")
    Me(TextBox & cstr(k)).Visible = True
    Me(TextBox & cstr(k)).SetFocus
  Else 
   MsgBox ("c'est ok")
  End If
  msg = "voulez-vous archiver des pièces de même nature ?"
  style = vbYesNo
  title = "archivage de  " & Me!Label1.Caption
  Archivage = MsgBox(msg, style, title)
End Function