Slt, comme dans l'intitulé, je veus mettre à jour un ruban perso par du code dont le code xml n'a pas onloadribbon.
Voici 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 <customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> <ribbon startFromScratch="true"> <tabs> <tab id="tab0" label="Access 2010 Tab"> <group id="grp0" autoScale="false" centerVertically="false" label="Access 2010 Ribbon"> <button id="btnInfo" size="normal" label="Info" imageMso="Info" onAction="OnActionButton" /> <button id="btn2_1_1" size="large" getLabel="GetLabel" getEnabled="GetEnabled" imageMso="ReviewAcceptChange" onAction="OnActionButton" /> <button id="btn2_1_2" size="large" getLabel="GetLabel" getEnabled="GetEnabled" imageMso="QueryShowTable" onAction="OnActionButton" /> <button id="btn2_1_4" size="large" getLabel="GetLabel" getEnabled="GetEnabled" imageMso="ChartTrendline" onAction="OnActionButton" /> </group> </tab> </tabs> </ribbon> </customUI>
J'utilise deux fonctions pour lancé Ce XML
1ère Function:
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 Function fnc_GetRibbon(lngVersion As Long) As String ' ************************************************************ ' Erstellt von : avenius ' Parameter : ' Rückgabe : String ' Erstellungsdatum : Mittwoch, 1 Aug 2012 ' Bemerkungen : ' Änderungen : ' ' **************** Created by IDBE Tools 2010 **************** Dim strProcName As String strProcName = "fnc_GetRibbon" On Error GoTo fnc_GetRibbon_Err Dim dbs As DAO.Database Dim rst As DAO.Recordset Set dbs = CurrentDb() Dim AfficheRibbon As Boolean AfficheRibbon = DLookup("DetectShift", "tblStartup", "boutonFonctions='" & "AfficheRibbon" & "'") If AfficheRibbon = True Then Select Case lngVersion Case 12 Set rst = dbs.OpenRecordset("SELECT * FROM USysRibbons WHERE RibbonName='A2007'", dbOpenDynaset) Case 15 Set rst = dbs.OpenRecordset("SELECT * FROM USysRibbons WHERE RibbonName='A2010'", dbOpenDynaset) Case Else Set rst = dbs.OpenRecordset("SELECT * FROM USysRibbons WHERE RibbonName='Default'", dbOpenDynaset) End Select Else Set rst = dbs.OpenRecordset("SELECT * FROM USysRibbons WHERE RibbonName='Default'", dbOpenDynaset) End If rst.MoveFirst fnc_GetRibbon = rst.Fields("RibbonXml") fnc_GetRibbon_Exit: rst.Close Set rst = Nothing Set dbs = Nothing Exit Function fnc_GetRibbon_Err: Select Case Err 'Case IhreFehlernummer 'Resume fnc_GetRibbon_Exit Case Else MsgBox "Es ist ein Fehler aufgetreten." & vbCrLf & vbCrLf & _ "In Function:" & vbTab & strProcName & vbCrLf & _ "Fehlernummer: " & vbTab & Err.Number & vbCrLf & _ "Beschreibung: " & vbTab & Err.description, vbCritical, _ "Fehler in " & Chr$(34) & strProcName & Chr$(34) Resume fnc_GetRibbon_Exit End Select End Function
2ème Function:
Déclaration des variables
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 Public Function fnc_LoadRibbon() Dim strProcName As String strProcName = "fnc_LoadRibbon" On Error GoTo fnc_LoadRibbon_Err Application.LoadCustomUI "DBRibbon", fnc_GetRibbon(Left(Application.Version, 2)) strImageMso = "FilePrepareMenu" gValide = "SaveAttachments" gEdibox = "" gDocNom = "Ouvrir un fichier" gSomme = "0 GNF" GetDossierEnabled = False fnc_LoadRibbon_Exit: Exit Function fnc_LoadRibbon_Err: Select Case Err 'Case IhreFehlernummer 'Resume fnc_LoadRibbon_Exit Case Else MsgBox "Es ist ein Fehler aufgetreten." & vbCrLf & vbCrLf & _ "In Function:" & vbTab & strProcName & vbCrLf & _ "Fehlernummer: " & vbTab & Err.Number & vbCrLf & _ "Beschreibung: " & vbTab & Err.description, vbCritical, _ "Fehler in " & Chr$(34) & strProcName & Chr$(34) Resume fnc_LoadRibbon_Exit End Select End Function
et une macro autoexec qui exécute la fonction "fnc_LoadRibbon"
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10 Public gobjRibbon As IRibbonUI Public strImageMso As String Public gEdibox As String Public gSomme As String Public gDocNom As String Public gValide As String Public GetDossierEnabled As Boolean Public Sub OnRibbonLoad(ribbon As IRibbonUI) Set gobjRibbon = ribbon End Sub
Quand je clique sur btnInfo, je veux mettre à jour le "btn2_1_1"
mais il y a toujour une erreur, comment remedié.
Partager