Problème de compréhension de code

Version imprimable

Bonjour à tous,

Actuellement en stage, je me suis inspirée d'un projet existant pour gérer le planning des congés.
Le code me parait difficile à comprendre, c'est pourquoi je viens solliciter votre aide.
Le code est le suivant :

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
Sub auto_open() 'Ouverture automatique
   On Error Resume Next
   Application.CommandBars("BarreColoriage").Delete
   CommandBars.Add ("BarreColoriage")
   CommandBars("BarreColoriage").Visible = True
   For i = 1 To Application.CountA([MesCouleurs]) + 1
      Set bouton = CommandBars("BarreColoriage").Controls.Add(Type:=msoControlButton)
      bouton.Style = msoButtonCaption
      bouton.Tag = Range("MotifsCongés")(i)
      bouton.OnAction = "'Coloriage """ & i & """'"
      bouton.Caption = Range("MesCouleurs")(i)
   Next i
End Sub
Sub Coloriage(p)
   Application.Calculation = xlCalculationManual
   Application.ScreenUpdating = False
   For Each c In Selection
         c.Value = Range("MesCouleurs")(p).Value
         ' C.Interior.ColorIndex = Range("MesCouleurs")(p).Interior.ColorIndex
         Range("MesCouleurs")(p).Copy c
         If Range("MotifsCongés")(p) <> "" Then
             If c.Comment Is Nothing Then c.AddComment ' Création des  commentaires
             c.Comment.Shape.OLEFormat.Object.Font.Name = "Tverdana" 'Définis la police
             c.Comment.Shape.OLEFormat.Object.Font.Size = 7 'Défini la taille de la police
             c.Comment.Shape.OLEFormat.Object.Font.FontStyle = "Normal" 'Défini le style de la police
             temp = Range("MotifsCongés")(p)
             c.Comment.Text Text:=temp
             c.Comment.Shape.TextFrame.AutoSize = True
             c.Comment.Visible = False
         Else
             c.ClearComments
         End If
    Next c
    Application.Calculation = xlCalculationAutomatic
End Sub
Sub auto_close()
    On Error Resume Next
    Application.CommandBars("BarreColoriage").Delete
End Sub

Merci d'avance à ceux qui auront pris le temps de m'aider.

Au plaisir de vous lire

Aphroditeuh

16/06/2009, 11h17
Krovax

Ca irait plus vite si tu nous disais ce que tu ne comprend pas dans le code. Car tout commenter serai un peu long ;)

Si tu compte répondre tout je ne peux que te conseiller de commencer par lire les différent tutoriel du site et faire des "exercice" avant de te lancer dans le code.
Si tu bloque juste sur quelque commande commence par regarder l'aide a leur sujet
(tu sélectionne le mot clef ou positionne ton curseur au milieu et apuie sur la touche F1)
16/06/2009, 11h29
Aphroditeuh

Merci Krovax d'avoir pris le temps de me répondre.
Je vais essayer avec F1 et si j'ai encore des questions, je repasserai ;)
Bonne journée

Vite fait quelques commentaires :

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
Sub auto_open() 'Ouverture automatique
   On Error Resume Next 'passer a l'instruction suivante si erreur
' ""'' Debut ajout de la barre d'outil "barrecoloriage """
   Application.CommandBars("BarreColoriage").Delete '=> Suppression si la barre existe déja
 
   CommandBars.Add ("BarreColoriage") ' => Ajout de la barre
   CommandBars("BarreColoriage").Visible = True ' rendre la barre visible
   For i = 1 To Application.CountA([MesCouleurs]) + 1 ' ajout de boutons
      Set bouton = CommandBars("BarreColoriage").Controls.Add(Type:=msoControlButton)
      bouton.Style = msoButtonCaption
      bouton.Tag = Range("MotifsCongés")(i)
      bouton.OnAction = "'Coloriage """ & i & """'" 'chaque bouton est associé à une macro ici appel de coloriage avec i en parametre
      bouton.Caption = Range("MesCouleurs")(i) 'titre du bouton
   Next i
End Sub
Sub Coloriage(p) 'macro appelée au clique du bouton 
   Application.Calculation = xlCalculationManual 'arret du calcul automatique
   Application.ScreenUpdating = False ' arret raffraichissement ecran
   For Each c In Selection 'parcours les cellules selectionnées
         c.Value = Range("MesCouleurs")(p).Value 'definni la couleur de la cellule
         ' C.Interior.ColorIndex = Range("MesCouleurs")(p).Interior.ColorIndex
         Range("MesCouleurs")(p).Copy c 'recopie de la celulle indice p de la plage nommée "MesCouleurs" vers la cellule c de la selection
         If Range("MotifsCongés")(p) <> "" Then 'si la cellule n'est pas vide
             If c.Comment Is Nothing Then c.AddComment ' Création des  commentaires
             c.Comment.Shape.OLEFormat.Object.Font.Name = "Tverdana" 'Définis la police
             c.Comment.Shape.OLEFormat.Object.Font.Size = 7 'Défini la taille de la police
             c.Comment.Shape.OLEFormat.Object.Font.FontStyle = "Normal" 'Défini le style de la police
             temp = Range("MotifsCongés")(p)
             c.Comment.Text Text:=temp
             c.Comment.Shape.TextFrame.AutoSize = True
             c.Comment.Visible = False
         Else
             c.ClearComments
         End If
    Next c
    Application.Calculation = xlCalculationAutomatic 'retour au calcul automatique
End Sub
Sub auto_close() ' se déclenche automatiquement a la fermeture
    On Error Resume Next
    Application.CommandBars("BarreColoriage").Delete 'suppression de la barre d'outil en fermeture du document
End Sub

Edit : ce code fonctionne avec plusieurs plages nommées.

16/06/2009, 13h28
Aphroditeuh

Merciiiiiiiiiiiiiiiii énormément aalex_38, tu m'enlève une épine du pied :ccool:
C'était même plus une épine, c'était presque un javelot :lol: