VBA raccourcir le code

Le 02/07/2014 à 18:56

bonjour la communauté,

voila j'ai un code vba pour entrer des notes .. sur 9 matieres, mais le probleme est qu'arrivé a la 6eme matiere, il m'indique que le code est trop long...comme je suis novice, y aurait il une ame charitable qui saurait m'expliquer comment le racourcir

Le code je l'ai mis sur un fichier texte car je ne peux inclure le fichier mais il est largement comprehensible

en vous remerciant par avance

15notes-essai.zip (1.85 Ko)
Le 02/07/2014 à 21:00

Bonjour,

A tester. c'est pas ce qu'on fait de plus court, mais ça reste compréhensible :

Private Sub CommandButton1_Click()
Msg = "il y a deja des premieres notes dans cette matiere! est ce la deuxieme note? " & _
      Chr(13) & Chr(10) & "    OUI c'est la deuxieme note  ; NON c'est la première note"

If ComboBox1.Value = "" Then
MsgBox "VOUS DEVEZ SELECTIONNER UNE MATIERE"
ComboBox1.SetFocus
Exit Sub
End If

'note 1ere matiere (premiere note)
If ComboBox1.Value = Sheets("session1").Range("AG4") And Application.CountA(Sheets("session1").Range("D4:D27")) > 0 Then
   réponse = MsgBox(Msg, vbYesNoCancel)
   Select Case réponse
   Case vbNo: remplir 4
   Case vbYes: remplir 5
   Case vbCancel: MsgBox ("inscription des notes abandonnée ")
   End Select
End If

If ComboBox1.Value = Sheets("session1").Range("AG4") And Application.CountA(Sheets("session1").Range("D4:D27")) = 0 Then remplir 4

'note 2 eme matiere
If ComboBox1.Value = Sheets("session1").Range("AG5") And Application.CountA(Sheets("session1").Range("G4:G27")) > 0 Then
réponse = MsgBox(Msg, vbYesNoCancel)
   réponse = MsgBox(Msg, vbYesNoCancel)
   Select Case réponse
   Case vbNo: remplir 7
   Case vbYes: remplir 8
   Case vbCancel: MsgBox ("inscription des notes abandonnée ")
   End Select
End If
If ComboBox1.Value = Sheets("session1").Range("AG5") And Application.CountA(Sheets("session1").Range("G4:G27")) = 0 Then remplir 7

'note 3 eme matiere
If ComboBox1.Value = Sheets("session1").Range("AG6") And Application.CountA(Sheets("session1").Range("J4:J27")) > 0 Then
   réponse = MsgBox(Msg, vbYesNoCancel)
   Select Case réponse
   Case vbNo: remplir 10
   Case vbYes: remplir 11
   Case vbCancel: MsgBox ("inscription des notes abandonnée ")
   End Select
End If
If ComboBox1.Value = Sheets("session1").Range("AG6") And Application.CountA(Sheets("session1").Range("J4:J27")) = 0 Then remplir 10

'note 4 eme matiere
If ComboBox1.Value = Sheets("session1").Range("AG7") And Application.CountA(Sheets("session1").Range("M4:M27")) > 0 Then
   réponse = MsgBox(Msg, vbYesNoCancel)
   Select Case réponse
   Case vbNo: remplir 13
   Case vbYes: remplir 14
   Case vbCancel: MsgBox ("inscription des notes abandonnée ")
   End Select
End If
If ComboBox1.Value = Sheets("session1").Range("AG7") And Application.CountA(Sheets("session1").Range("M4:M27")) = 0 Then remplir 13

'note 5 eme matiere
If ComboBox1.Value = Sheets("session1").Range("AG8") And Application.CountA(Sheets("session1").Range("P4:P27")) > 0 Then
   réponse = MsgBox(Msg, vbYesNoCancel)
   Select Case réponse
   Case vbNo: remplir 16
   Case vbYes: remplir 17
   Case vbCancel: MsgBox ("inscription des notes abandonnée ")
   End Select
End If
If ComboBox1.Value = Sheets("session1").Range("AG8") And Application.CountA(Sheets("session1").Range("P4:P27")) = 0 Then remplir 16

'note 6 eme matiere
If ComboBox1.Value = Sheets("session1").Range("AG9") And Application.CountA(Sheets("session1").Range("S4:S27")) > 0 Then
   réponse = MsgBox(Msg, vbYesNoCancel)
   Select Case réponse
   Case vbNo: remplir 19
   Case vbYes: remplir 20
   Case vbCancel: MsgBox ("inscription des notes abandonnée ")
   End Select
End If
If ComboBox1.Value = Sheets("session1").Range("AG9") And Application.CountA(Sheets("session1").Range("S4:S27")) = 0 Then remplir 19

'note 7 eme matiere
If ComboBox1.Value = Sheets("session1").Range("AG10") And Application.CountA(Sheets("session1").Range("V4:V27")) > 0 Then
   réponse = MsgBox(Msg, vbYesNoCancel)
   Select Case réponse
   Case vbNo: remplir 22
   Case vbYes: remplir 23
   Case vbCancel: MsgBox ("inscription des notes abandonnée ")
   End Select
End If
If ComboBox1.Value = Sheets("session1").Range("AG10") And Application.CountA(Sheets("session1").Range("V4:V27")) = 0 Then remplir 22

'note 8 eme matiere
If ComboBox1.Value = Sheets("session1").Range("AG11") And Application.CountA(Sheets("session1").Range("Y4:Y27")) > 0 Then
   réponse = MsgBox(Msg, vbYesNoCancel)
   Select Case réponse
   Case vbNo: remplir 25
   Case vbYes: remplir 26
   Case vbCancel: MsgBox ("inscription des notes abandonnée ")
   End Select
End If
If ComboBox1.Value = Sheets("session1").Range("AG11") And Application.CountA(Sheets("session1").Range("Y4:Y27")) = 0 Then remplir 25

'note 9 eme matiere
If ComboBox1.Value = Sheets("session1").Range("AG12") And Application.CountA(Sheets("session1").Range("AB4:AB27")) > 0 Then
   réponse = MsgBox(Msg, vbYesNoCancel)
   Select Case réponse
   Case vbNo: remplir 28
   Case vbYes: remplir 29
   Case vbCancel: MsgBox ("inscription des notes abandonnée ")
   End Select
End If
If ComboBox1.Value = Sheets("session1").Range("AG12") And Application.CountA(Sheets("session1").Range("AB4:AB27")) = 0 Then remplir 28
End Sub

Private Sub remplir(i)
With Sheets("session1")
.Cells(4, i) = TextBox1.Value
.Cells(5, i) = TextBox2.Value
.Cells(6, i) = TextBox3.Value
.Cells(7, i) = TextBox4.Value
.Cells(8, i) = TextBox5.Value
.Cells(9, i) = TextBox6.Value
.Cells(10, i) = TextBox7.Value
.Cells(11, i) = TextBox8.Value
.Cells(12, i) = TextBox9.Value
.Cells(13, i) = TextBox10.Value
.Cells(14, i) = TextBox11.Value
.Cells(15, i) = TextBox12.Value
.Cells(16, i) = TextBox13.Value
.Cells(17, i) = TextBox14.Value
.Cells(18, i) = TextBox15.Value
.Cells(19, i) = TextBox16.Value
.Cells(20, i) = TextBox17.Value
.Cells(21, i) = TextBox18.Value
.Cells(22, i) = TextBox19.Value
.Cells(23, i) = TextBox20.Value
.Cells(24, i) = TextBox21.Value
.Cells(25, i) = TextBox22.Value
.Cells(26, i) = TextBox23.Value
.Cells(27, i) = TextBox24.Value
.Cells(28, i) = TextBox25.Value
End With
End Sub

A+

Le 02/07/2014 à 21:21

bonsoir galopin01 ,

Super mega merci testé et approuvé..j'ai bataillé toute l'aprem pour trouver quelque chose mais au taf je n'ai pas le net donc c’était pas facile...

en tout cas au grand merci

Le 03/07/2014 à 07:29

Bonjour,

On peut encore remplacer avantageusement la Sub remplir de la manière suivante :

Private Sub remplir(i)
For k = 1 To 25
    Sheets("session1").Cells(k + 3, 1) = Me.Controls("TextBox" & k).Value
Next
End Sub

A+

Rechercher des sujets similaires à "vba raccourcir code"