mettre a jour un controls dans le ruban custoUI par le click d'un autre controls

Version imprimable

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:

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:

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:

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 :koi:
quelqu'un aurait une idée ?

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:

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

09/04/2019, 10h29
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

1 pièce(s) jointe(s)

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:

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
Pièce jointe 465131
un fichier en exemple

me reste a faire

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
activer le bouton des qu'une mise a jour mois est faite avec une des subs

1 pièce(s) jointe(s)

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

Code:

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

Pièce jointe 465150

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