Discussion :

[patricktoulon]

bonjour je suis dans une periode exeperiences

j'essaie de coder un control calendrier dans mon ruban
pour le xml dans le customUI ca donne ceci

Code xml :

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
 
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="RibbonSet"> 
  <ribbon>
    <tabs>
      <tab id="test" label="test" >
        <group id="group1" label="Calendrier">
        <gallery id="gallery01" 
            size="large"
            imageMso="StartAfterPrevious" 
            label="Calendar"
            columns="7"             
            getItemCount="Nbjour"
            showItemLabel="true"
            getItemLabel="Labeljour"
            onAction="Selectionjour" > 
        </gallery> 
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

pour le vba les callbacks

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
Option Explicit
Public MonRuban As IRibbonUI
Dim Usf As Object
Public calendar As IRibbonControl
Public madate
'Callback for customUI.onLoad
'Est déclenché lors du chargement du ruban personnalisé.
Sub RibbonSet(ribbon As IRibbonUI)
    Set MonRuban = ribbon
End Sub
 
'Callback for gallery01 getItemCount
Sub Nbjour(control As IRibbonControl, returnedVal)
    Set calendar = control
    returnedVal = 42
End Sub
 
'Callback for gallery01 getItemLabel
Sub Labeljour(control As IRibbonControl, index As Integer, returnedVal)
   Dim d, nextday
      If IsEmpty(madate) Then madate = Date
    d = Day(DateSerial(Year(madate), Month(madate), 1))
     nextday = Day(DateSerial(Year(madate), Month(madate) + 1, 0))
   returnedVal = IIf(index + 1 >= d And index + 1 <= nextday, index + 1, "-")
End Sub

et par exemple je souterais changer le mois avec cette sub declancher éventuellement par un autre bouton ou controls dans le ruban

Code :

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

1
2
3
4
5
6
7
Sub test()
madate = CDate("01/06/2019")
Nbjour calendar, 42
Labeljour calendar,1, 5
MonRuban.InvalidateControl "gallery01"
RibbonSet MonRuban
End Sub

alors au load du ruban c'est le mois en cours qui se créé et je voudrais pouvoir le changer par une sub ou un autre bouton
la sub ci dessus ne déclenche pas d'erreur mais ne fait rien
quelqu'un aurait une idée ?

[patricktoulon]

Bon je me suis rendu compte qu'en fait ca fonctionne a moitié
la mise a jour se fait mais c'est le placement qui ne se fait pas correctement
j'ai modifié le code comme suit

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
 
Option Explicit
Public MonRuban As IRibbonUI
Dim Usf As Object
Public calendar As IRibbonControl
Public mois As Long
'Callback for customUI.onLoad
'Est déclenché lors du chargement du ruban personnalisé.
Sub RibbonSet(ribbon As IRibbonUI)
 
    Set MonRuban = ribbon
End Sub
 
'Callback for gallery01 getItemCount
Sub Nbjour(control As IRibbonControl, returnedVal)
    Set calendar = control
    returnedVal = 42
End Sub
 
'Callback for gallery01 getItemLabel
Sub Labeljour(control As IRibbonControl, index As Integer, returnedVal)
   Dim d, nextday
      If mois = 0 Then mois = Month(Date): MsgBox "coucou"
     d = Day(DateSerial(2019, mois, 1))
     nextday = Day(DateSerial(2019, mois, 0))
   returnedVal = IIf(index >= d And index <= nextday, Format(index + 1, "#00"), "-")
End Sub
Sub test()
mois = 7
Nbjour calendar, 42
MonRuban.InvalidateControl "gallery01"
End Sub

[Invité]

Bonjour Patrick

Lorsque tu lances la Maj des Ctrl (MonRuban.InvalidateControl "gallery01") c'est toujours la CallBack Sub Labeljour qui met le contrôle à jour. Et comme il n'est pas modifié, tu auras toujours le même résultat.
Il faudrait déporter ton code qui calcule la date et renvoyer ensuite les résultats dans ReturnedVal avant la Maj du Ctrl.

Cordialement,
Sophie

[patricktoulon]

re
bonjour clochette en fait c'était plus simple que ca , j'ai confondu day et weekday dans la précipitation
c'est bien weekday qu'il me fallait pour position le 01 au bon endroit

du coup j'ai un peu modifié tout ca et avec 2 sub de tests février et aout je change

me reste maintenant a déclencher le bouton pour que la galery s'affiche quand je lance une des sub

le code xml toujours le même

vba

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
[
Option Explicit
Public MonRuban As IRibbonUI
Public calendar As IRibbonControl
Public mois As Long
'
'Callback for customUI.onLoad
'Est déclenché lors du chargement du ruban personnalisé.
Sub RibbonSet(ribbon As IRibbonUI)
    Set MonRuban = ribbon
End Sub
'
'Callback for gallery01 getItemCount
Sub Nbjour(control As IRibbonControl, returnedVal)
    Set calendar = control
    returnedVal = 42
End Sub
'
'Callback for gallery01 getItemLabel
Sub Labeljour(control As IRibbonControl, index As Integer, returnedVal)
    Dim d, nextday, r
    If mois = 0 Then mois = Month(Date)
    d = Weekday(DateSerial(2019, mois, 1), vbMonday)
    nextday = Day(DateSerial(2019, mois + 1, 0))
    If (index + 1) >= d Then r = Format(index + 1 - d + 1, "#00") Else r = "-"
    If (index + 1) > nextday + d - 1 Then r = "-"
    returnedVal = r
End Sub
'
Sub testfevrier()
    mois = 2
    Nbjour calendar, 42
    MonRuban.InvalidateControl "gallery01"
End Sub
'
Sub testaout()
    mois = 8
    Nbjour calendar, 42
    MonRuban.InvalidateControl "gallery01"
End Sub

un fichier en exemple

me reste a faire

1. déterminer l'object monRuban autrement qu'avec le load au cas ou j'ai une erreur déclenchée dans vba( n'importe ou) car la variable monruban est vidé et donc perdue
2. activer le bouton des qu'une mise a jour mois est faite avec une des subs

[patricktoulon]

re
il evoulue encore on a maintenant les entêtes de colonnes jours
l'evenement labeljour

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
'Callback for gallery01 getItemLabel
Sub Labeljour(control As IRibbonControl, index As Integer, returnedVal)
    Dim d, nextday, r, arrjour
    arrjour = Array("Lun", "Mar", "Mer", "Jeu", "Ven", "Sam", "Dim")
    If mois = 0 Then mois = Month(Date)
    If index + 1 > 7 Then
        d = Weekday(DateSerial(2019, mois, 1), vbMonday)
        nextday = Day(DateSerial(2019, mois + 1, 0))
        If (index + 1) >= d + 7 Then r = Format(index + 1 - d - 6, "#00") Else r = "-"
        If (index + 1) > nextday + d + 6 Then r = "-"
        returnedVal = r
    Else
        returnedVal = arrjour(index)
    End If
End Sub

reste toujours a faire

le reload du ruban en cas de crash vba
l'affichage l'ors du changement de mois

et ce sera bon