Macro VBA pour afficher agenda de toutes les réunions Répondre

**Celine2018** · 05/03/2024, 12h00

Bonjour,

Je sollicite votre aide mes amis pour insérer une macro VBA dans le fichier excel ci-joint, qui permettra d'afficher sur la première page en couleur les cases correspondantes à toutes les réunions affichées sur les 8 autres feuilles excel (un consolidé d'agenda). Merci d'avance.

Celine.

**a_diard** · 05/03/2024, 15h25

Petit code sur la base du fichier.

Je l'ai mis sur l'activation de la feuille Agenda Réunions CNCH.
Je pense qu'il serait mieux de mettre un bouton compiler
et peut être un bouton effacer sur la base du même code.

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
Private Sub Worksheet_Activate()
Dim Variablecolonne(21)
Dim Variableligne(20)
 
Variableligne(0) = 9
Variableligne(1) = 10
Variableligne(2) = 11
Variableligne(3) = 12
Variableligne(4) = 13
 
Variableligne(5) = 19
Variableligne(6) = 20
Variableligne(7) = 21
Variableligne(8) = 22
Variableligne(9) = 23
 
Variableligne(10) = 32
Variableligne(11) = 33
Variableligne(12) = 34
Variableligne(13) = 35
Variableligne(14) = 36
 
Variableligne(15) = 46
Variableligne(16) = 47
Variableligne(17) = 48
Variableligne(18) = 49
Variableligne(19) = 50
 
 
Variablecolonne(0) = 2
Variablecolonne(1) = 3
Variablecolonne(2) = 4
Variablecolonne(3) = 5
Variablecolonne(4) = 6
Variablecolonne(5) = 7
Variablecolonne(6) = 8
 
Variablecolonne(7) = 11
Variablecolonne(8) = 12
Variablecolonne(9) = 13
Variablecolonne(10) = 14
Variablecolonne(11) = 15
Variablecolonne(12) = 16
Variablecolonne(13) = 17
 
Variablecolonne(14) = 21
Variablecolonne(15) = 22
Variablecolonne(16) = 23
Variablecolonne(17) = 24
Variablecolonne(18) = 25
Variablecolonne(19) = 26
Variablecolonne(20) = 27
 
For onglet = 1 To 8
 
For ligne = 0 To 19
For colonne = 0 To 20
 
If Sheets(CStr(onglet)).Cells(Variableligne(ligne), Variablecolonne(colonne)).Interior.Pattern = xlSolid Then
With Sheets("Agenda Réunions CNCH").Cells(Variableligne(ligne), Variablecolonne(colonne)).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
Next
Next
End Sub

Remise a Zero de la Synthése

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
 Sub EffacerSynthése()
Dim Variablecolonne(21)
Dim Variableligne(20)
 
Variableligne(0) = 9
Variableligne(1) = 10
Variableligne(2) = 11
Variableligne(3) = 12
Variableligne(4) = 13
 
Variableligne(5) = 19
Variableligne(6) = 20
Variableligne(7) = 21
Variableligne(8) = 22
Variableligne(9) = 23
 
Variableligne(10) = 32
Variableligne(11) = 33
Variableligne(12) = 34
Variableligne(13) = 35
Variableligne(14) = 36
 
Variableligne(15) = 46
Variableligne(16) = 47
Variableligne(17) = 48
Variableligne(18) = 49
Variableligne(19) = 50
 
 
Variablecolonne(0) = 2
Variablecolonne(1) = 3
Variablecolonne(2) = 4
Variablecolonne(3) = 5
Variablecolonne(4) = 6
Variablecolonne(5) = 7
Variablecolonne(6) = 8
 
Variablecolonne(7) = 11
Variablecolonne(8) = 12
Variablecolonne(9) = 13
Variablecolonne(10) = 14
Variablecolonne(11) = 15
Variablecolonne(12) = 16
Variablecolonne(13) = 17
 
Variablecolonne(14) = 21
Variablecolonne(15) = 22
Variablecolonne(16) = 23
Variablecolonne(17) = 24
Variablecolonne(18) = 25
Variablecolonne(19) = 26
Variablecolonne(20) = 27
 
For onglet = 1 To 8
 
For ligne = 0 To 19
For colonne = 0 To 20
 With Sheets("Agenda Réunions CNCH").Cells(Variableligne(ligne), Variablecolonne(colonne)).Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
 
Next
Next
Next
End Sub

**BENNASR** · 05/03/2024, 15h53

Bonjour Celine, a_diard, la forum
Je propose de réserver une couleur pour chaque onglet et comme ça l'onglet récap sera bq plus lisible
merci de supprimer l'autre discussion : c'est un doublon

https://www.developpez.net/forums/d2...utes-reunions/

autre proposition

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
Sub test()
Dim M1 As Range
Dim M2 As Range
Dim M3 As Range
Dim M4 As Range
Dim M5 As Range
Dim M6 As Range
Dim M7 As Range
Dim M8 As Range
Dim M9 As Range
Dim M10 As Range
Dim M11 As Range
Dim M12 As Range
Dim F As Worksheet
Dim R As Range
Application.ScreenUpdating = False
With Sheets("Agenda Réunions CNCH")
.Range("B9:H13").Interior.ColorIndex = xlColorIndexNone
.Range("K9:Q13").Interior.ColorIndex = xlColorIndexNone
.Range("U9:AA13").Interior.ColorIndex = xlColorIndexNone
.Range("B19:H23").Interior.ColorIndex = xlColorIndexNone
.Range("K19:Q23").Interior.ColorIndex = xlColorIndexNone
.Range("U19:AA24").Interior.ColorIndex = xlColorIndexNone
.Range("B32:H36").Interior.ColorIndex = xlColorIndexNone
.Range("K32:Q36").Interior.ColorIndex = xlColorIndexNone
.Range("U32:AA36").Interior.ColorIndex = xlColorIndexNone
.Range("B46:H50").Interior.ColorIndex = xlColorIndexNone
.Range("K46:Q50").Interior.ColorIndex = xlColorIndexNone
.Range("U46:AA50").Interior.ColorIndex = xlColorIndexNone
End With
 For Each F In Worksheets
        If F.Name <> "Agenda Réunions CNCH" Then
        Set M1 = F.Range("B9:H13")
        Set M2 = F.Range("K9:Q13")
        Set M3 = F.Range("U9:AA13")
        Set M4 = F.Range("B19:H23")
        Set M5 = F.Range("K19:Q23")
        Set M6 = F.Range("U19:AA24")
        Set M7 = F.Range("B32:H36")
        Set M8 = F.Range("K32:Q36")
        Set M9 = F.Range("U32:AA36")
        Set M10 = F.Range("B46:H50")
        Set M11 = F.Range("K46:Q50")
        Set M12 = F.Range("U46:AA50")
        Set Plage = Application.Union(M1, M2, M3, M4, M5, M6, M7, M8, M9, M10, M11, M12)
          For Each R In Plage
          If R.Interior.ColorIndex <> xlColorIndexNone Then
          lig = R.Row
          Col = R.Column
          Sheets("Agenda Réunions CNCH").Cells(lig, Col).Interior.ColorIndex = R.Interior.ColorIndex
          End If
          Next R
          End If
  Next F
Application.ScreenUpdating = True
End Sub

**a_diard** · 05/03/2024, 16h00

Ca me semble beaucoup mieux, bonne soirée.

Il serait même possible d'alerter si 2 réunions étaient prévues le même jour.

Mais,on sait bien que ça n'arrive jamais.

**fraflt69** · 05/03/2024, 16h12

Bonjour Celine

Une solution avec les commentaires sur les cellules

Sub MAJ_Agenda()
Dim ShAgenda As Worksheet
Dim sh As Worksheet
Dim cell As Range
Dim cellAgenda As Range
Dim savText
Set ShAgenda = Sheets("Agenda Réunions CNCH")
For Each sh In Worksheets
If Len(sh.Name) = 1 Then
Set rg = sh.UsedRange
For Each cell In rg
If IsNumeric(cell.Value) And Not IsEmpty(cell) And cell.Interior.Color <> 16777215 Then '0 Then 'And Not cell Is Empty
Set cellAgenda = ShAgenda.Cells(cell.Row, cell.Column)
If Not cellAgenda.Comment Is Nothing Then
savText = cellAgenda.Comment
cellAgenda.Comment.Delete
cellAgenda.AddComment = savText + " " + sh.Name
Else
cellAgenda.AddComment sh.Name
End If
End If

Next
End If
Next

End Sub

**BENNASR** · 05/03/2024, 16h20

re

Suite proposition de a_diard (bonjour au passage ) et pour éviter deux réunion en même date je propose ce bricolage :

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
Sub test()
Dim M1 As Range
Dim M2 As Range
Dim M3 As Range
Dim M4 As Range
Dim M5 As Range
Dim M6 As Range
Dim M7 As Range
Dim M8 As Range
Dim M9 As Range
Dim M10 As Range
Dim M11 As Range
Dim M12 As Range
Dim F As Worksheet
Dim R As Range
Application.ScreenUpdating = False
With Sheets("Agenda Réunions CNCH")
.Range("B9:H13").Interior.ColorIndex = xlColorIndexNone
.Range("K9:Q13").Interior.ColorIndex = xlColorIndexNone
.Range("U9:AA13").Interior.ColorIndex = xlColorIndexNone
.Range("B19:H23").Interior.ColorIndex = xlColorIndexNone
.Range("K19:Q23").Interior.ColorIndex = xlColorIndexNone
.Range("U19:AA24").Interior.ColorIndex = xlColorIndexNone
.Range("B32:H36").Interior.ColorIndex = xlColorIndexNone
.Range("K32:Q36").Interior.ColorIndex = xlColorIndexNone
.Range("U32:AA36").Interior.ColorIndex = xlColorIndexNone
.Range("B46:H50").Interior.ColorIndex = xlColorIndexNone
.Range("K46:Q50").Interior.ColorIndex = xlColorIndexNone
.Range("U46:AA50").Interior.ColorIndex = xlColorIndexNone
End With
 For Each F In Worksheets
        If F.Name <> "Agenda Réunions CNCH" Then
        Set M1 = F.Range("B9:H13")
        Set M2 = F.Range("K9:Q13")
        Set M3 = F.Range("U9:AA13")
        Set M4 = F.Range("B19:H23")
        Set M5 = F.Range("K19:Q23")
        Set M6 = F.Range("U19:AA24")
        Set M7 = F.Range("B32:H36")
        Set M8 = F.Range("K32:Q36")
        Set M9 = F.Range("U32:AA36")
        Set M10 = F.Range("B46:H50")
        Set M11 = F.Range("K46:Q50")
        Set M12 = F.Range("U46:AA50")
        Set Plage = Application.Union(M1, M2, M3, M4, M5, M6, M7, M8, M9, M10, M11, M12)
          For Each R In Plage
          If R.Interior.ColorIndex <> xlColorIndexNone Then
          lig = R.Row
          Col = R.Column
          If Sheets("Agenda Réunions CNCH").Cells(lig, Col).Interior.ColorIndex <> xlColorIndexNone Then
          MsgBox ("Vous avez deux réunion en même date !!! merci de vérifier")
          F.Select
          R.Select
          Exit Sub
          Else
          Sheets("Agenda Réunions CNCH").Cells(lig, Col).Interior.ColorIndex = R.Interior.ColorIndex
          End If
          End If
          Next R
          End If
  Next F
 
Application.ScreenUpdating = True
End Sub

**Philippe Tulliez** · 05/03/2024, 17h58

Bonjour,
Pour éviter de construire une usine à gaz, je ne peux que vous conseiller de revoir l'organisation de vos données.
Une table contenant les jours, heures de rendez-vous, personnes concernées, etc.
Ensuite avec des formules natives vous pouvez consulter ce que vous souhaitez

**Celine2018** · 06/03/2024, 13h01

Les réunions concernent les mêmes groupes de travail, et c'est durant une journée entière.

Cependant je voudrais aussi afficher l'objet de chaque reunion pour chaque date dans ce meme fichier avec recap de reunions (macro)

Est ce que vous pouvez me proposez un modèle ou une macro

**BENNASR** · 06/03/2024, 13h25

Ou tu écris les objets de tes réunions ?
Aucun objet de réunion n'est mentionné ds ton exemple !!!!
C'est un commentaire ds le cellule du calendrier ?
Bref, S'il s'agit des commentaires insérés dans chaque cellule de calendrier tu peux faire avec :
NB : En l'absence d'une commentaires tu trouve le commentaire : pas d'objet pour cette réunion...tu peux voir la case appropriée et tu ajoute l'objet de la réunion

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
Sub test()
Dim M1 As Range
Dim M2 As Range
Dim M3 As Range
Dim M4 As Range
Dim M5 As Range
Dim M6 As Range
Dim M7 As Range
Dim M8 As Range
Dim M9 As Range
Dim M10 As Range
Dim M11 As Range
Dim M12 As Range
Dim F As Worksheet
Dim R As Range
Dim X As String
Application.ScreenUpdating = False
With Sheets("Agenda Réunions CNCH")
.Range("B9:H13").Interior.ColorIndex = xlColorIndexNone
.Range("K9:Q13").Interior.ColorIndex = xlColorIndexNone
.Range("U9:AA13").Interior.ColorIndex = xlColorIndexNone
.Range("B19:H23").Interior.ColorIndex = xlColorIndexNone
.Range("K19:Q23").Interior.ColorIndex = xlColorIndexNone
.Range("U19:AA24").Interior.ColorIndex = xlColorIndexNone
.Range("B32:H36").Interior.ColorIndex = xlColorIndexNone
.Range("K32:Q36").Interior.ColorIndex = xlColorIndexNone
.Range("U32:AA36").Interior.ColorIndex = xlColorIndexNone
.Range("B46:H50").Interior.ColorIndex = xlColorIndexNone
.Range("K46:Q50").Interior.ColorIndex = xlColorIndexNone
.Range("U46:AA50").Interior.ColorIndex = xlColorIndexNone
.Cells.ClearComments
End With
 For Each F In Worksheets
        If F.Name <> "Agenda Réunions CNCH" Then
        Set M1 = F.Range("B9:H13")
        Set M2 = F.Range("K9:Q13")
        Set M3 = F.Range("U9:AA13")
        Set M4 = F.Range("B19:H23")
        Set M5 = F.Range("K19:Q23")
        Set M6 = F.Range("U19:AA24")
        Set M7 = F.Range("B32:H36")
        Set M8 = F.Range("K32:Q36")
        Set M9 = F.Range("U32:AA36")
        Set M10 = F.Range("B46:H50")
        Set M11 = F.Range("K46:Q50")
        Set M12 = F.Range("U46:AA50")
        Set Plage = Application.Union(M1, M2, M3, M4, M5, M6, M7, M8, M9, M10, M11, M12)
          For Each R In Plage
          If R.Interior.ColorIndex <> xlColorIndexNone Then
          If Not R.Comment Is Nothing Then
           X = R.Comment.Text
           Else
           X = "Pas d'objet pour cette réunion"
           End If
          lig = R.Row
          Col = R.Column
          If Sheets("Agenda Réunions CNCH").Cells(lig, Col).Interior.ColorIndex <> xlColorIndexNone Then
          MsgBox ("Vous avez deux réunion en même date !!! merci de vérifier")
          F.Select
          R.Select
          Exit Sub
          Else
          Sheets("Agenda Réunions CNCH").Cells(lig, Col).Interior.ColorIndex = R.Interior.ColorIndex
          If IsNull(X) Then X = "Pas d'objet pour cette réunion"
          With Sheets("Agenda Réunions CNCH").Cells(lig, Col).AddComment
           .Shape.Placement = xlFreeFloating
           .Shape.TextFrame.AutoSize = True
           .Text Text:=X
           End With
          End If
          End If
          Next R
          End If
  Next F
Application.ScreenUpdating = True
End Sub

**deedolith** · 06/03/2024, 16h17

Salut,

Après avoir regardé, je me dit qu'il y a un gros problème: Tu n'as aucun modèle de données.
En effet, que trouves t'on dans les feuilles ?
Des visuels de calendriers, et rien d'autre.
Aucune information exploitable sur les dates, l'objet des réunions, les groupes de travail ect ...

Je te suggère de d'abord travailler la dessus.

Macro VBA pour afficher agenda de toutes les réunions Répondre

Macros et VBA Excel

Discussions similaires

Partager

Partager