Groupe d'options dans ruban

**Guy FALESSE** · 26/08/2012, 11h21

Bonjour à tous,

Je n'ai rien vu dans les forums, mais...
Pourrait-on faire une groupe d'options ou simuler un groupe d'options sur le ruban.
Par exemple, un groupe d'options comprenant 4 cases à cocher et lorsqu'une case est cochée et qu'on clique dans une autre case, celle qui est cochée serait décochée.
Je ne sais pas le faire rien qu'avec des cases à cocher "seules" il faut les décocher en cliquant dedans.
D'avance merci poour vos conseils.

Guy FALESSE

**LedZeppII** · 26/08/2012, 14h09

Bonjour,

Effectivement, on ne sais pas agir en VBA sur les contrôles d'un ruban.
La seule action possible est d'invalider des contrôles, ou d'invalider le ruban.

Sur le principe, pour faire ce que tu demandes, il faut mémoriser la dernière case qui a été cochée, puis invalider les cases à cocher pour que le ruban appelle la fonction de rappel getPressed, laquelle permettra de décider si une case doit être cochée ou non.

Exemple de ruban et de code vba associé.
Le ruban :

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
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onRibbonLoad"> 
<ribbon startFromScratch="false">
    <tabs>
        <tab id="CaseACocher" label="Case à cocher test" visible="true">
            <group id="grpCaseACocherExclusives" label = "Case à cocher mutuellement exclusives">
                <box id="boxCAC_EXCL" boxStyle="horizontal">
                    <checkBox id="chkNoteMauvais" label="Mauvais"
                              onAction="chkAction" getPressed="chkGetPressed" />
                    <checkBox id="chkNoteMoyen" label="Moyen"
                              onAction="chkAction" getPressed="chkGetPressed" />
                    <checkBox id="chkNoteBon" label="Bon"
                              onAction="chkAction" getPressed="chkGetPressed" />
                    <checkBox id="chkNoteExcellent" label="Excellent"
                              onAction="chkAction" getPressed="chkGetPressed" />
                </box>
            </group>
        </tab>
    </tabs>
</ribbon>
</customUI>

Le ruban comporte quatre cases à cocher (chkNoteMauvais, chkNoteMoyen, chkNoteBon, chkNoteExcellent).
Il fait appel à des fonctions de rappel:
onRibbonLoad : permet de mémoriser le ruban
chkAction : déclenché sur clic sur une case à cocher
getPressed : appelée par le ruban pour savoir si une case doit être cochée ou non.

Le 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
' Variable conservant le nom de la case à cocher qui est cochée
Dim sChkNoteCtlId As String
 
' Variable objet pour le ruban
Dim oRubTstChkBx As IRibbonUI
 
'---------------------------------------------------------------
' onLoad - Mémorisation du ruban
'---------------------------------------------------------------
Sub onRibbonLoad(ribbon As IRibbonUI)
    Set oRubTstChkBx = ribbon
End Sub
 
'---------------------------------------------------------------
' checkBox - onAction
'---------------------------------------------------------------
Sub chkAction(ByVal control As IRibbonControl, pressed As Boolean)
Select Case control.ID
 
    Case "chkNoteMauvais", "chkNoteMoyen", "chkNoteBon", "chkNoteExcellent"
        If pressed Then
            '  On mémorise la dernière case cochée
            sChkNoteCtlId = control.ID
            ' On invalide les cases à cocher chkNoteXXXX
            chkNotesInvalider
        Else
            '  On ne mémorise rien
            sChkNoteCtlId = ""
        End If
End Select
End Sub
 
'---------------------------------------------------------------
' checkBox - getPressed
'---------------------------------------------------------------
Sub chkGetPressed(control As IRibbonControl, ByRef returnValue)
Select Case control.ID
 
    Case "chkNoteMauvais", "chkNoteMoyen", "chkNoteBon", "chkNoteExcellent"
        If control.ID = sChkNoteCtlId Then
            returnValue = True
        Else
            returnValue = False
        End If
 
End Select
End Sub
 
'---------------------------------------------------------------
' checkBoxes chkNotexxxx - Invalider
'---------------------------------------------------------------
Sub chkNotesInvalider()
If Not (oRubTstChkBx Is Nothing) Then
   oRubTstChkBx.InvalidateControl "chkNoteMauvais"
   oRubTstChkBx.InvalidateControl "chkNoteMoyen"
   oRubTstChkBx.InvalidateControl "chkNoteBon"
   oRubTstChkBx.InvalidateControl "chkNoteExcellent"
Else
    MsgBox "oRubTstChkBx Is Nothing"
End If
End Sub

La variable globale sChkNoteCtlId sert à mémoriser l'Id de la case à cocher qui doit être la seule à être cochée, parmi les quatre.

A+

**Guy FALESSE** · 26/08/2012, 14h18

Bonjour,

Merci pour ta réponse.

Je vais tester cela dans le courant de l'après-midi.
@+
Guy FALESSE

**Guy FALESSE** · 26/08/2012, 15h08

Bonjour LedZeppII,

Encore merci

Cela fonctionne à merveille.
Il me reste maintenant à comprendre.
Surtout comprendre pourquoi mes projets ne fonctionnaient jamais et pouvoir, j'espère, comprendre de plus en plus ce ruban.

@+

Guy FALESSE

**LedZeppII** · 26/08/2012, 19h37

Re,

Il me reste maintenant à comprendre

Comme je l'ai dit, on ne peut pas agir directement sur les contrôles, et on ne peut donc pas cocher/décocher les cases à cocher en vba.
Pour cette raison, j'ai ajouté l'attribut onAction="chkAction" aux éléments checkBox.
Quand on clique sur une case à cocher, cela déclenche l'événement onAction qui va appeler la fonction de rappel chkAction.
Cette fonction vérifie en premier lieu, que l'Id du contrôle est bien celui d'une des quatre cases à cocher.
Si c'est le cas, elle vérifie ensuite l'état de l'argument pressed.

Si pressed = True, la case est cochée.
On sauve l'Id de la case à cocher dans la variable sChkNoteCtlId.
On invalide les quatre cases à cocher, ce qui force le ruban à appeler la fonction de rappel chkGetPressed.
Cette fonction de rappel est déclarée par l'attribut getPressed="chkGetPressed" dans chaque case à cocher.
Si pressed = False, la case est décochée.
On vide la variable sChkNoteCtlId.

La fonction de rappel chkGetPressed (déclarée par getPressed="chkGetPressed"):
Elle est appelée lorsque le ruban est affiché pour la première fois, et à chaque fois qu'on invalide les quatre cases à cocher.
Elle sert à donner l'état (coché/décoché) de la case à cocher, pour la quelle le ruban appelle cette fonction de rappel.
L'état est renvoyé par l'intermédiaire de l'argument returnValue, lequel est un argument par référence et non par valeur.
La logique est de renvoyer True(coché) si l'Id de la case à cocher, pour laquelle le ruban veut connaître l'état, est égale à l'Id contenu dans la variable sChkNoteCtlId.

Pour résumer, on invalide les cases à cocher, pour forcer le ruban à appeler chkGetPressed (fonction de rappel getPressed).
C'est un peu comme si on disait au ruban, demande moi l'état des cases à cocher que je viens d'invalider.

A+

**Guy FALESSE** · 26/08/2012, 20h04

Bonsoir LedZeppII,

C'est plein de "trucs" dont je ne soupçonnais même pas l'existence.
Sur vba, on trouve des traités et des tutoriels, mais sur la programmation des rubans, à part quelques tutoriels, bien faits, en général.
Je n'ai rien trouvé encore.
En tout cas, encore merci, j'ai commencé à comprendre un peu le mécanisme de ces fonctions.

@+
Guy FALESSE

**Guy FALESSE** · 31/08/2012, 14h20

Bonjour LedZepII

Je me permets de te demander encore de l'aide à cause du ruban.

J'essaye ceci:

Code :

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

1
2
3
4
Private Sub Form_Open(Cancel As Integer)
    Dim rubanAAA As IRibbonUI
    rubanAAA.ActivateTabMso "Gestion des achats"
End Sub

Erreur '91'
Donc l'erreur est: Variable objet ou variale de bloc with non definie.
Alors là?
D'avance merci,
Guy FALESSE

**LedZeppII** · 31/08/2012, 21h10

Bonsoir,

Une variable objet de type IRibbonUI ne peut être initialisée, que dans la fonction de rappel déclarée dans l'attribut onLoad de l'élément customUI.
Si je reprend mon exemple, l'élément customUI est celui-ci :

Code xlm :

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

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onRibbonLoad">

La fonction de rappel est donc : onRibbonLoad

Toujours dans mon exemple, la déclaration de la variable objet de type IRibbonUI, et la fonction (une Sub en réalité) de rappel onRibbonLoad :

Code :

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

1
2
3
4
5
6
7
8
9
' Variable objet pour le ruban
Dim oRubTstChkBx As IRibbonUI
 
'---------------------------------------------------------------
' onLoad - Mémorisation du ruban
'---------------------------------------------------------------
Sub onRibbonLoad(ribbon As IRibbonUI)
    Set oRubTstChkBx = ribbon
End Sub

Personnellement, ce que je fait, c'est que je crée un module de code VBA dédié à tout ce qui est en rapport avec le ruban.
Dans ce module, tu pourrai créer une sub comme ça :

Code :

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

1
2
3
4
5
6
7
8
9
10
'---------------------------------------------------------------
' Activer un onglet du ruban
'---------------------------------------------------------------
Sub ActiverOnglet(idOnglet As String)
If Not (oRubTstChkBx Is Nothing) Then
   oRubTstChkBx.ActivateTab idObglet
Else
    MsgBox "oRubTstChkBx Is Nothing"
End If
End Sub

Pour activer un onglet intégré (natif Access) :

Code :

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

1
2
3
4
5
6
7
8
9
10
'---------------------------------------------------------------
' Activer un onglet Office
'---------------------------------------------------------------
Sub ActiverOngletMso(idOngletMso As String)
If Not (oRubTstChkBx Is Nothing) Then
   oRubTstChkBx.ActivateTabMso idOngletMso 
Else
    MsgBox "oRubTstChkBx Is Nothing"
End If
End Sub

Ton code serait donc :

Code :

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

1
2
3
Private Sub Form_Open(Cancel As Integer)
    ActiverOnglet "Gestion des achats"
End Sub

A+

**Guy FALESSE** · 31/08/2012, 21h45

Bonsoir LedZeppII,

Merci pour ta réponse

C'est vraiment plus compliqué.
Je n'ai pas encore acquis la compréhension de toute cette programmation.
Au fait, ce n'est pas un onglet dédié Access mais un onglet personnalisé, je pense que je me suis trompé dans la question, donc, je dois utiliser ActivateTab et non ActivateTabMso, je présume?
Enfin, je verrai cela demain.
Bonne soirée et à demain, sans doute.

Guy FALESSE

**Guy FALESSE** · 01/09/2012, 09h23

Bonjour LedZeppII,

Malheureusement, J'ai une erreur '5':
Argument ou appel de procédure incorrect dans:

Code :

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

1
2
3
4
5
6
7
8
9
10
'---------------------------------------------------------------
' Activer un onglet du ruban
'---------------------------------------------------------------
Sub ActiverOnglet(idOnglet As String)
    If Not (rubanAAA Is Nothing) Then
        rubanAAA.ActivateTab idOnglet
    Else
        MsgBox "rubanAAA Is Nothing"
    End If
End Sub

J'ai fait un copié/collé de tes sub.
Sauf que j'ai remplacé ton nom de ruban par le mien puisque c'est le mien qui est utilisé dans mon programme.
Sinon, cela aurait fait trois rubans.
Ce ne serait tout de même pas ça.
@+
Guy FALESSE

**LedZeppII** · 01/09/2012, 12h51

Bonjour,

Est-ce que l'id de l'onglet est bien correcte ?

En y repensant, ça me semble étrange de voir des espaces dans un id ("Gestion des achats").
Tu n'aurai pas pris le label au lieu de l'id ?

A+

**Guy FALESSE** · 01/09/2012, 13h02

Bonjour,

Bien sûr, c'est ce que j'ai fait

Ça fonctionne comme il faut maintenant.
Désolé de mon manque d'attention

Encore merci pour tes conseils.

@+
Guy FALESSE

**Guy FALESSE** · 04/09/2012, 14h26

Bonjour LedZeppII,

Puis-je encore avoir besoin de tes services?
J'essaye de "faire" un comboBox.
J'ai une table tblListeRayons dont le champ s'appelle ListeRayons
J'aimerais qu'en cliquant sur un élement de la liste qu'une commande soit effectuée.

Code :

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

	<comboBox  id="cmbListeRayons" label="Liste rayons :" getItemCount="getListeRayonsCount" getItemLabel="getListeRayonsLabel" onChange="onChangeListeRayons" />

Mon problème est que ma table contient jusque maintenant 3 enregistrements et que le comboBox contient 3 éléménts, mais les mêmes, c'est à dire 3 fois le premier.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub getListeRayonsLabel(control As IRibbonControl, index As Integer, ByRef label)
    Dim ORst As Recordset
    Set ORst = CurrentDb.OpenRecordset("SELECT * FROM TblListeRayons;")
On Error GoTo err
    With ORst
        label = .Fields(0)
        .MoveNext
    End With
Exit Sub
err:
MsgBox err.Description
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub getListeRayonsCount(control As IRibbonControl, ByRef count)
    Dim ORst As Recordset
    Set ORst = CurrentDb.OpenRecordset("SELECT * FROM TblListeRayons;")
    'Récupère le nombre d'enregistrements
With ORst
        .MoveLast
        count = .RecordCount
        .MoveFirst
    End With
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub getListeRayonsLabel(control As IRibbonControl, index As Integer, ByRef label)
    Dim ORst As Recordset
    Set ORst = CurrentDb.OpenRecordset("SELECT * FROM TblListeRayons;")
On Error GoTo err
    With ORst
        label = .Fields(0)
        .MoveNext
    End With
Exit Sub
err:
MsgBox err.Description
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub onChangeListeRayons(control As IRibbonControl, ListeRayons As String)
    Select Case control.Id
        Case "cmbListeRayons"
        SelectionListeRayons = ListeRayons
        MsgBox "" & ListeRayons
    End Select
 
    If Not (rubanAAA2 Is Nothing) Then
        rubanAAA2.InvalidateControl "cmbListeRayons"
    End If
End Sub

Code :

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

1
2
3
Public Function ValeurVarListeRayons() As String
    ValeurVarListeRayons = SelectionListeRayons
End Function

Pourrais-tu me dire ce qui cloche, je suis dessus depuis un bon moment?

D'avance merci,

Guy FALESSE

**LedZeppII** · 04/09/2012, 19h42

Bonsoir,

Le problème c'est le MoveNext dans la Sub getListeRayonsLabel.
Tu renvoie à chaque fois le deuxième enregistrement.

Pour construire la liste, le ruban va appeler getListeRayonsLabel, autant de fois qu'il y a d'éléments dans la comboBox.
S'il y a trois éléments, le ruban va appeler getListeRayonsLabel ...
Une première fois avec index=0
Une deuxième fois avec index=1
Une troisième fois avec index=2

On peut donc remplacer

Code :

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

        .MoveNext

par

Code :

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

        .Move index

pour se placer sur le bon enregistrement dans le recordset.

Remarque:
Je vois que dans la sub onChangeListeRayons, tu invalides le contrôle comboBox.
Ça veut dire que la prochaine fois que tu ouvres la liste de la comboBox, tu reconstruis entièrement la liste en refaisant appel à getListeRayonsCount et getListeRayonsLabel.
A mon avis ça n'est pas utile (ça n'est qu'un avis

).
Il n'est nécessaire de la faire, que s'il y a eu des modifications dans la table TblListeRayons (ajout/suppression/modification d'enregistrement)

A+

**Guy FALESSE** · 04/09/2012, 20h07

Bonsoir LedZeppII,

Merci pour ta réponse, malheureusement, je reste toujours au 1er enregistrement.
Bizarre non?

@+

Guy FALESSE

**Guy FALESSE** · 05/09/2012, 13h58

Bonjour LedzeppII,

Après quelques recherches et de copies, ça fonctionne enfin, bizarre, mais c'est comme ça.
J'ai suivi ton conseil, j'ai mis des apostrophes devant les invalides.
Voici les codes au cas où:

XML:ComboBox_ribbon_Rayons.xml

Code :

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

1
2
3
4
5
6
7
8
9
10
11
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="onRibbonLoad"> 
<ribbon startFromScratch="true">
    <tabs>
        <tab id="LeComboBox" label="ComboBox à tester" visible="true">
        <group id="UnComboBox" label = "le ComboBox">
			<comboBox  id="cmbRayons" label="Liste rayons :" getItemCount="getRayonsCount" getItemLabel="getRayonsLabel" onChange="onChangeRayons" />
        </group>
        </tab>
    </tabs>
</ribbon>
</customUI>

Les codes 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
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
Option Compare Database
Option Explicit
 
'Déclaration du Ruban 2007
Dim gobjRibbon As IRibbonUI
 
Private oRst As DAO.Recordset
Dim db As DAO.Database
 
'Sélection du Rayons
Public SelectionRayons As String
 
Sub getRayonsCount(control As IRibbonControl, ByRef count)
    Set oRst = CurrentDb.OpenRecordset("SELECT * FROM TblRayons;")
    'Récupère le nombre d'enregistrements
With oRst
        .MoveLast
        count = .RecordCount
        .MoveFirst
    End With
End Sub
 
Sub getRayonsLabel(control As IRibbonControl, index As Integer, ByRef label)
On Error GoTo err
    With oRst
        label = .Fields("ID_Rayons")
        .MoveNext
    End With
Exit Sub
err:
MsgBox err.Description
End Sub
 
Public Function LoadRibbon()
    Dim strXML As String
    Dim oFso As New FileSystemObject
    Dim oFtxt As TextStream
'Charge le fichier XML en mémoire
    Set oFtxt = oFso.OpenTextFile(CurrentProject.Path & _
      "\ComboBox_ribbon_Rayons.xml", ForReading)
 'Récupère le contenu
    strXML = oFtxt.ReadAll
'Charge le rubban personnalisé correspondant
    Application.LoadCustomUI "gobjRibbon", strXML
 
Set oFso = Nothing
End Function
 
Sub onChangeRayons(control As IRibbonControl, ListeRayons As String)
    On Error GoTo Err_onChangeListeRayons
 
    Select Case control.ID
        Case "cmbRayons"
        SelectionRayons = ListeRayons
        MsgBox ("") & ListeRayons
    End Select
 
  '  If Not (gobjRibbon Is Nothing) Then
  '      gobjRibbon.InvalidateControl "cmbVille"
  '  End If
 
Exit_onChangeListeRayons:
    Exit Sub
 
Err_onChangeListeRayons:
    'MsgBox Err.Description
    Resume Exit_onChangeListeRayons
End Sub
 
Sub onRibbonLoad(ribbon As IRibbonUI)
    Set gobjRibbon = ribbon
End Sub
 
Public Function ValeurVarRayons() As String
    ValeurVarRayons = SelectionRayons
End Function

Voilà, encore merci pour tous tes conseils

@+

Guy FALESSE

Groupe d'options dans ruban [AC-2010]

IHM

Discussions similaires

Partager

Partager