Discussion :

[Ram34]

Bonjours à tous,

Est - il possible d'afficher quelque que chose qui ressemble à la pièce jointe dans un ruban personnalisé Access 2007 ?

Un champ avec le nombre d'enregistrements total et la position de l'enregistrement en cours ??

Précision --> La pièce jointe c'est la petite barre d'outil qu'access affiche en bas d'un formulaire lorsqu'on met OUI a l'option 'Boutons de déplacement'

[Dolphy35]

Bonjour,

pour moi c'est possible

http://access.developpez.com/cours/?...eform#formmenu

@++

[Ram34]

J'arrive a avoir une partie de la réponse (<- Précédent Suivant -> et Premier et dernier) en programmant le ruban comme ceci :

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
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
    <ribbon startFromScratch="true">
         <tabs>
              <tab id="tabEvenement" label="Gestion des événements" visible="true">
                   <group id="Boutonsdeplacement" visible="true">
                        <button idMso="MailMergeGoToPreviousRecord" size="normal"/>
                        <button idMso="MailMergeGoToFirstRecord" size="normal"/>
                        <separator id="separator4"/>
                        <button idMso="MailMergeGoToNextRecord" size="normal"/>
                        <button idMso="MailMergeGotToLastRecord" size="normal"/>
                   </group>
              </tab>
         </tabs>
    </ribbon>
</customUI>

Mais je galère pour le nombre d'enregistrements et la position !!!

[jimbolion]

Ram34,

En parcourant un peu le Web, je pense que cela devrait beaucoup t'intéresser :

http://msdn.microsoft.com/en-us/libr...ffice.12).aspx

Regarde principalement la partie : The customized navigation control in the Ribbon

JimBoLion

[Ram34]

jiimbolion,

Cela ressemble exactement a ce que je recherche ... je m'y met et je vous tiens au courant...

merci

[jimbolion]

Ram34,

Lorsque tu auras fini mets nous tout çà dans un petit doc, cela interessera beaucoup de membres.

Merci d'avance

JimBoLion

[Ram34]

Je viens d'essayer le tuto que m'a proposé jiimbolion , très intéressante comme d’ailleurs

pour ceux que ça intéresse de ce déplacer entre les enregistrements et il permet aussi d'atteindre un enregistrement par son numéro. Vous voulez l'enregistrement 60 sur 600, et ben vous aurez le 60 !!! cool non ?

Par contre il n'affiche pas le nombre total des enregistrements et la position de l'enregistrement en cours ... retour à la case départ...

je cherche, je cherche...

[Ram34]

Alors pour ceux que cela interesse :
le code Xml :

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
                   <group id="grpNav" label="Navigation" visible="true">
                        <button id="btnSample" label="Ouvrir un Formulaire" imageMso="AccessFormModalDialog" tag="frmCustomers" onAction="OnOpenForm"/>
                        <box id="boxNavLbl" boxStyle="horizontal">
                             <labelControl id="lblNav" getLabel="OnGetLabel"/>
                        </box>
                        <box id="boxNav" boxStyle="horizontal">
                             <buttonGroup id="bg1">
                                  <button id="btnNavFirst" imageMso="MailMergeGoToFirstRecord" onAction="OnNavigateRecord" getEnabled="OnGetNavEnabled"/>
                                  <button id="btnNavPrev" imageMso="MailMergeGoToPreviousRecord" onAction="OnNavigateRecord" getEnabled="OnGetNavEnabled"/>
                             </buttonGroup>
                             <editBox id="txtJump" sizeString="000000" onChange="OnChangeRecord" getText="OnGetText"/>
                             <buttonGroup id="bg2">
                                  <button id="btnNavNext" imageMso="MailMergeGoToNextRecord" onAction="OnNavigateRecord" getEnabled="OnGetNavEnabled"/>
                                  <button id="btnNavLast" imageMso="MailMergeGotToLastRecord" onAction="OnNavigateRecord" getEnabled="OnGetNavEnabled"/>
                             </buttonGroup>
                        </box>
                   </group>

Et pour l'affichage :

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
Public Sub OnGetLabel(ctl As IRibbonControl, ByRef label)
Dim f As Form
    If (ctl.ID = "lblNav") Then
        If (Forms.count = 0) Then
            label = "Pas de Formulaire Actif"
        Else
            Set f = Screen.ActiveForm
            label = "Enreg. " & f.CurrentRecord & " of " & _
                                f.RecordsetClone.RecordCount
            If (f.FilterOn) Then
                label = label & " (Filtered)"
            End If
        End If
    End If
End Sub

Normalement la mise a jours doit s'effectuer avec ce 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
Public Sub OnNavigateRecord(ctl As IRibbonControl)
    Dim lRecord As AcRecord
 
    Select Case ctl.Id
        Case "btnNavFirst": lRecord = acFirst
        Case "btnNavPrev": lRecord = acPrevious
        Case "btnNavNext": lRecord = acNext
        Case "btnNavLast": lRecord = acLast
    End Select
 
     ' do the navigation
    DoCmd.GoToRecord , , lRecord
 
    If (Not gobjRibbon Is Nothing) Then
        ' invalidate the nav label
        gobjRibbon.InvalidateControl "lblNav"
 
        ' invalidate the button to enable/disable
        gobjRibbon.InvalidateControl ctl.Id
    End If
End Sub

et puis cela

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub InvalidateNavControls() 
    With gobjRibbon 
        .InvalidateControl "lblNav" 
        .InvalidateControl "btnNavFirst" 
        .InvalidateControl "btnNavPrev" 
        .InvalidateControl "btnNavNext" 
        .InvalidateControl "btnNavLast" 
    End With 
End Sub

Sauf que la mise à jour du ruban ne d’effectué pas ...

[LedZeppII]

Bonsoir,

Voila comment j'ai remanié le code VBA pour le ruban.

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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
Dim gobjRibbon As Office.IRibbonUI
 
' Callback onLoad
Public Sub rubNav_OnLoad(ribbon As Office.IRibbonUI)
    Set gobjRibbon = ribbon
End Sub
 
' Callback getEnabled
Public Sub OnGetNavEnabled(ctl As IRibbonControl, ByRef Enabled)
Dim f As access.Form
    If (Forms.count > 0) Then
        Set f = Screen.ActiveForm
 
        Select Case ctl.ID
            Case "btnNavFirst"
                Enabled = (f.CurrentRecord > 1)
            Case "btnNavPrev"
                Enabled = (f.CurrentRecord > 1)
            Case "btnNavNext"
                Enabled = (f.CurrentRecord < f.Recordset.RecordCount)
            Case "btnNavLast"
                Enabled = (f.CurrentRecord < f.Recordset.RecordCount)
        End Select
    End If
End Sub
 
' Callback getText
Public Sub OnGetText(ctl As IRibbonControl, ByRef Text)
    If (ctl.ID = "txtJump") Then
        Text = ""
    End If
End Sub
 
' Callback getLabel
Public Sub OnGetLabel(ctl As IRibbonControl, ByRef label)
Dim f As Form
    If (ctl.ID = "lblNav") Then
        If (Forms.count = 0) Then
            label = "Pas de Formulaire Actif"
        Else
            Set f = Screen.ActiveForm
            label = "Enreg. " & f.CurrentRecord & " of " & _
                                f.RecordsetClone.RecordCount
            If (f.FilterOn) Then
                label = label & " (Filtered)"
            End If
        End If
    End If
End Sub
 
' Callback onChange
Public Sub OnChangeRecord(ctl As IRibbonControl, Text)
    If (Not IsNumeric(Text)) Then
        MsgBox "Please enter a number", vbExclamation, "Cannot Move Record"
        InvalidateNavControl "txtJump"
    Else
        ' Effectuer le déplacement
        With Screen.ActiveForm.Recordset
            .MoveFirst
            If (CLng(Text) > .RecordCount Or CLng(Text) < 1) Then
                MsgBox "Cannot move to specified record", vbInformation
            Else
                .Move CLng(Text) - 1
            End If
        End With
        ' Invalider txtJump pour le vider
        InvalidateNavControl "txtJump"
    End If
End Sub
 
' Callback onAction (button)
Public Sub OnNavigateRecord(ctl As IRibbonControl)
    Dim lRecord As AcRecord
 
    Select Case ctl.ID
        Case "btnNavFirst": lRecord = acFirst
        Case "btnNavPrev": lRecord = acPrevious
        Case "btnNavNext": lRecord = acNext
        Case "btnNavLast": lRecord = acLast
    End Select
 
    ' Effectuer le déplacement
    DoCmd.GoToRecord , , lRecord
    ' Invalider les contrôles boutons de déplacement et l'étiquette
    ' d'information de position dans le jeu d'enregistrements
    InvalidateNavControls
End Sub
 
' Sub pour invalider un contrôle du ruban
Public Sub InvalidateNavControl(sCtlID As String)
    If Not (gobjRibbon Is Nothing) Then
        gobjRibbon.InvalidateControl sCtlID
    End If
End Sub
 
' Sub pour invalider certains contrôles de navigation du ruban
Public Sub InvalidateNavControls()
    If Not (gobjRibbon Is Nothing) Then
        With gobjRibbon
            .InvalidateControl "lblNav"
            .InvalidateControl "btnNavFirst"
            .InvalidateControl "btnNavPrev"
            .InvalidateControl "btnNavNext"
            .InvalidateControl "btnNavLast"
        End With
    End If
End Sub

Ensuite, au niveau du formulaire, dans l'événement «sur activation»:

Code :

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

1
2
3
Private Sub Form_Current()
    InvalidateNavControls
End Sub

Cela permet de synchroniser le ruban sur l'enregistrement actif du formulaire.
Attention: La sub InvalidateNavControls était Private, je l'ai passé en Public.

A+

[Ram34]

Merci LedZeppII (groupe mythique s'il en est)

Effectivement l 'erreur public /privat était bien vu...

Alors cela fonctionne parfaitement !!! j'invite ceux qui développe de se casser la tête sur les rubans cela améliore considérablement l’ergonomie de nos applications...