Procédure trop longue

Version imprimable

Bonjour,
je veux réaliser un planning avec un bouton permettant de demander le nom de la personne et ensuite sa tranche horaire pour ainsi la visualiser en couleur sur une plage horaire.

Ce qui est bien c'est que j'ai réussi mais ma procédure est trop longue (erreur de compilation), je l'ai donc séparer avec un bouton "matin" et un bouton "apres midi" mais ça serait plus sympa avec un SEUL bouton !
je ne sais pas comment on peut faire pour avoir un seul bouton !!

J'aimerais avoir de l'aide pour finaliser ça s'il vous plait !!!

Le fichier : Pièce jointe 215326

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
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
 
Sub gerere()
  Dim resultat As String
  Dim deb As Integer
  Dim fin As Integer
  Dim plage As Range
    deb = 7
    fin = 100
Do
     resultat = InputBox("Donner le nom", "Gestion")
     If resultat <> "" Then 'Si la valeur est différente de "" on affiche le résultat
        Range("A" & deb).Value = resultat
        Else
           Exit Do
 
          End If
 
     heureSaisie = InputBox("Donner le début de l'heure au format xx:xx", "heure")
 
        ' Vérifiaction de la validitée
         If Len(heureSaisie) Then
         Dim tm() As String
         tmp = Split(heureSaisie, ":")
          End If
 
         ' Présence de deux :
        If UBound(tmp) = 2 Then
 
         ' Lers valeurs sont numériques
            If IsNumeric(tmp(0)) And IsNumeric(tmp(1)) Then
            erreur = False
            End If
 
         End If
 
    heureSaisi = InputBox("Donner la fin de l'heure au format xx:xx", "heure")
 
        ' Vérifiaction de la validitée
         If Len(heureSaisi) Then
         Dim tmr() As String
         t = Split(heureSaisi, ":")
          End If
 
         ' Présence de deux :
        If UBound(t) = 2 Then
 
         ' Lers valeurs sont numériques
            If IsNumeric(t(0)) And IsNumeric(t(1)) Then
            erreur = False
            End If
         End If
 
 
If tmp(0) = 5 And tmp(1) = 30 And t(0) = 8 And t(1) = 30 Then                     '5:30
           Set plage = Range("B" & deb, "G" & deb)
           plage.Interior.ColorIndex = 50
           End If
           If tmp(0) = 5 And tmp(1) = 30 And t(0) = 9 And t(1) = 0 Then
           Set plage = Range("B" & deb, "H" & deb)
           plage.Interior.ColorIndex = 50
           End If
            If tmp(0) = 5 And tmp(1) = 30 And t(0) = 9 And t(1) = 30 Then
           Set plage = Range("B" & deb, "I" & deb)
           plage.Interior.ColorIndex = 50
           End If
           If tmp(0) = 5 And tmp(1) = 30 And t(0) = 10 And t(1) = 0 Then
           Set plage = Range("B" & deb, "J" & deb)
           plage.Interior.ColorIndex = 50
           End If
           If tmp(0) = 5 And tmp(1) = 30 And t(0) = 10 And t(1) = 30 Then
           Set plage = Range("B" & deb, "K" & deb)
           plage.Interior.ColorIndex = 50
           End If
           If tmp(0) = 5 And tmp(1) = 30 And t(0) = 11 And t(1) = 0 Then
           Set plage = Range("B" & deb, "L" & deb)
 
etc.....
 
     If tmp(0) = 12 And tmp(1) = 30 And t(0) = 20 And t(1) = 30 Then
           Range("P" & deb).Interior.ColorIndex = 50
           Set plage = Range("Q" & deb, "AE" & deb)
           plage.Interior.ColorIndex = 4
           End If
           If tmp(0) = 12 And tmp(1) = 30 And t(0) = 20 And t(1) = 45 Then
           Range("P" & deb).Interior.ColorIndex = 50
           Set plage = Range("Q" & deb, "AF" & deb)
           plage.Interior.ColorIndex = 4
           End If
Call ge   'du coup je veux appeler l'autre bouton "apres midi" qui ressemble à la  
                   meme  chose que précédemment mais sa ne fonctionne pas :/
 
 
    Range("A" & deb) = Range("A" & deb) + Incr
    deb = deb + 2
 
Loop Until deb = fin + 2
 
 
 
End Sub

Bonjour,

Beaucoup de remarques :

Plusieurs erreurs :
Dim tm() as string au lieu de Dim tmp() as string Dim tmr() mais utilisation de t() (non déclaré)

Améliorations:
Suppression de plusieurs if et else inutiles
Déclaration de toutes les variables dès le départ
Utilisation d 'un for à place du Do Loop until Faire appel à une fonction externe pour colorier les plages (moins de lignes dans le code), plus simple d'ajouter de nouvelles instructions

Questions
A quoi sert la variable erreur? Elle n'est pas définie et jamais utilisée
Y a-t-il une cohérence dans les plages? Possibilité de boucler pour trouver les colonnes et lignes en fonction de ce qui est rempli? Ecart entre deux plages toujours identique?

Et donc le code amélioré, corrigé quand c'était possible, rendu un peu plus simple et plus lisible. (Je précise qu'on peut encore l'améliorer, probablement même beaucoup)

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
 
Sub gerere()
    Dim resultat As String
    Dim deb As Integer
    Dim plage As Range
    Dim tmp() As String, tmr() As String
    Dim erreur As Boolean
 
    For deb = 7 To 102 Step 2
        resultat = InputBox("Donner le nom", "Gestion")
        If resultat = "" Then Exit For 'Si la valeur est différente de "" on affiche le résultat
 
        Range("A" & deb).Value = resultat
 
        heureSaisie = InputBox("Donner le début de l'heure au format xx:xx", "heure")
 
        ' Vérifiaction de la validitée
        If Len(heureSaisie) Then tmp = Split(heureSaisie, ":")
 
        ' Présence de deux ; les valeurs sont numériques
        If UBound(tmp) = 2 Then erreur = Not (IsNumeric(tmp(0)) And IsNumeric(tmp(1)))
 
        heureSaisi = InputBox("Donner la fin de l'heure au format xx:xx", "heure")
 
        ' Vérifiaction de la validitée
        If Len(heureSaisi) Then tmr = Split(heureSaisi, ":")
 
        ' Présence de deux ; les valeurs sont numériques
        If UBound(tmr) = 2 Then erreur = Not (IsNumeric(tmr(0)) And IsNumeric(tmr(1)))
 
        If tmp(0) = 5 And tmp(1) = 30 Then
            If tmr(0) = 8 And tmr(1) = 30 Then Call coloriage(Range("B" & deb, "G" & deb), 50)
            If tmr(0) = 9 And tmr(1) = 0 Then Call coloriage(Range("B" & deb, "H" & deb), 50)
            If tmr(0) = 9 And tmr(1) = 30 Then Call coloriage(Range("B" & deb, "I" & deb), 50)
            If tmr(0) = 10 And tmr(1) = 0 Then Call coloriage(Range("B" & deb, "J" & deb), 50)
            If tmr(0) = 10 And tmr(1) = 30 Then Call coloriage(Range("B" & deb, "K" & deb), 50)
 
'''''''''A vérifier, Lignes manquantes
            If tmp(0) = 5 And tmp(1) = 30 And tmr(0) = 11 And tmr(1) = 0 Then Call coloriage(Range("B" & deb, "L" & deb), 50)
''''''''''''''''''''''''''''''''''''''
 
        End If
 
        If tmp(0) = 12 And tmp(1) = 30 And tmr(0) = 20 Then
            If tmr(1) = 30 Then
                Call coloriage(Range("P" & deb), 50)
                Call coloriage(Range("Q" & deb, "AE" & deb), 4)
            End If
 
            If tmr(1) = 45 Then
                Call coloriage(Range("P" & deb), 50)
                Call coloriage(Range("Q" & deb, "AF" & deb), 4)
            End If
        End If
 
        Call ge   'du coup je veux appeler l'autre bouton "apres midi" qui ressemble à la
 
        Range("A" & deb).Value = Range("A" & deb).Value + Incr
        deb = deb + 2
    Next deb
End Sub
 
Private Sub coloriage(rng As Range, couleur As Integer)
    rng.Interior.ColorIndex = couleur
End Sub

Je te précise que peu de personnes ici ouvrent les fichiers joints, surtout ceux contenant des macros (je fais partie des méfiants)

13/07/2016, 17h15
lurrik

1 pièce(s) jointe(s)

Géniale :D Merci jeanmidudu, sérieusement c'est super d'avoir des gens comme toi qui n'hésite pas à prendre leur temps pour aider et apprendre aux autres.
Un grand merci, bravo :)

Et une dernière chose même si c'est pas forcement l'intitulé de ce forum mais il y a t-il moyen selon toi de réaliser un trie comme représenté sur l'image ci-dessous :

Pièce jointe 215382

Si pour toi ça parait évident et pas très compliqué, peux tu m'aider s'il te plait ?
13/07/2016, 17h24
francis60

Bonjour lubrick,

Citation:

Plusieurs erreurs :
Dim tm() as string au lieu de Dim tmp() as string
Dim tmr() mais utilisation de t() (non déclaré)

Pour éviter ce genre d'oublis, ajoute:

Code:

Option Explicit

en tête de ton module et le debugger t'alertera.

Essaie d'être plus précis, une procédure trop longue, c'est quoi ?
Une procédure qui a un temps d'excecution trop long ou bien c'est ton code qui est trop long et du coup il est difficile de s'y retrouver ?

jeanmidudu est trop sympa avec toi, montre-toi digne de son support, il y a plein de bonnes chose à apprendre dans ce qu'il a codé pour toi !