Discussion :

[patmeziere]

Bonjour à tous
j'ai un petit soucis avec un code de récupération de l'object ruban
le code me fait planter excel
je joins un fichier excel exemple au cas ou

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
Option Explicit
 
#If Mac Then
    Private Declare PtrSafe Function CopyMemory_byVar Lib "libc.dylib" Alias "memmove" (ByRef dest As Any, ByRef src As Any, ByVal size As Long) As LongPtr
    Dim lRibbonPointer As LongPtr
#Else
    #If VBA7 Then
        Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef dest As Any, ByVal src As LongPtr, ByVal size As LongPtr)
        Dim lRibbonPointer As LongPtr
    #Else
        Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef dest As Any, ByVal src As Long, ByVal size As Long)
        Dim lRibbonPointer As Long
    #End If
#End If
 
#If VBA7 Then
Function GetRibbon(ByVal lRibbonPointer As LongPtr) As IRibbonUI
#Else
Function GetRibbon(ByVal lRibbonPointer As Long) As IRibbonUI
#End If
    Dim objRibbon As IRibbonUI
    If lRibbonPointer <> 0 Then
        #If Mac Then
            CopyMemory_byVar objRibbon, lRibbonPointer, LenB(lRibbonPointer)
        #Else
            CopyMemory objRibbon, lRibbonPointer, LenB(lRibbonPointer)
        #End If
    End If
    Set GetRibbon = objRibbon
End Function
 
 
Sub SafeRibbon()
    On Error GoTo ErrorHandler
    MsgBox "Tentative de récupération du ruban"
    lRibbonPointer = ThisWorkbook.Sheets(1).Range("a2").Value
    Set myRibbon = GetRibbon(lRibbonPointer)
    If Not myRibbon Is Nothing Then
        myRibbon.Invalidate
    Else
        MsgBox "Erreur : impossible de récupérer l'objet Ribbon."
    End If
    Exit Sub
 
ErrorHandler:
    MsgBox "Erreur : " & Err.Description
End Sub

[deedolith]

Salut,

J'ai déja essayé un truc comme ça, c'est extrêmement instable.
Ce qui ne m'étonne pas, VBA est un langage haut niveau, qui n'a pas grand chose à carrer des pointeurs qui par définition sont bas niveau. Sans compter que la tambouille interne d'Excel doit également interférer (je pense aux transtypages automatiques).

Rien ne vaut une appli bien architecturée et fail-proof.

Quand au projet qui s'effondre lorsque tu édites quelque chose, je pense que c'est un mal pour un bien, car ca force a fermer / reouvrir le classeur (re-initialisation de l'application dans un état connu).

[patmeziere]

Bonjour deedolith
mon app est relativement bien structuré tu n'a pas compris le contexte
je parle d'autres classeurs éventuellements ouvert qui bugueraient sur une macro ce qui entraine immédiatement le choix fin/deboguage
en cas de deboguage toute variable est détruite et donc celle du ruban aussi

donc il me faut une solution

[deedolith]

je parle d'autres classeurs éventuellements ouvert qui bugueraient sur une macro ce qui entraine immédiatement le choix fin/deboguage

Heu ...

La solution ne serait-elle pas de corriger les anomalies ?
Si tu fais un contournement ou passage en force, les anomalies seront toujours la.
Et (Loi de Murphy oblige), elle sauront te rappeler leur présence au "meilleur" moment.

[patmeziere]

re
corrigé ou pas là n'est pas la question
quand il arrive une erreur je perd mon object ribbon
c'est pas compliqué a comprendre
j'ai besoins de ce sauve conduit c'est tout

visiblement tu réponds sans comprendre le contexte
donc je vais essayer d'expliquer
j'ai un fichier avec un ruban perso avec des control dynamique donc utilisation de myrribon.invalidate
d'autre fichiers sont ouverts qui viennent d'autres membre d'un forum
c'est fichiers parfois contienent des erreurs
la je choisi deboguage pour aller corriger
sauf que le deboguage réinitialise toute variables public ou global module dans tout les classeur
une fois corrigé je voudrais récupérer le ruban (mes outils)
voilà j'espère avoir été plus clair

[deedolith]

Après recherches approfondies, je n'ai pas mieux à proposer.

Au risque de me répéter, j'ai déjà essayé cette technique, ca s'est révélé inutilisable tellement c'est instable.
Avec en bonus le risque de corruption du classeur, ca ne vaut pas le coup.

Tu es en train de dire qu'une erreur d'exécution dans 1 classeur fais tomber tous les projets ?
Pas normal, 1 seul projet est supposé s'effondrer (ou alors, il y a des dépendances que tu ne nous dit pas).

Sinon, les bases du debugging ?
Points d'arrêts, instruction Stop, instruction Debug.Print, exécuter en pas à pas, espions ?
Tracking des erreurs qui peut être fait avec une classe très simple ?

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
'// Module de classe: ErrorLogger
Option Explicit
 
Private mModuleName as String
Private mFunctionName as String
 
Friend Sub Create(ByVal ModuleName As String, ByValFunctionName As String)
    mModuleName = ModuleName
    mFunctionName = FunctionName
End Sub
 
Private Sub Class_Terminate()
    If(Err.Number <> 0) Then
        Debug.Print mModuleName & "." & mFunctionName & " : " & Err.Description
    End If
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
'// Module standard: Factory
Option Explicit
 
    '// Fonction en charge d'instancier un objet de type ErrorLogger
Public Function CreateErrorLogger(ByVal ModuleName As String, ByVal FunctionName As String) As ErrorLogger
    Dim Logger As ErrorLogger
    Set Logger = New ErrorLogger
 
    Logger.Create ModuleName, FunctionName
    Set CreateErrorLogger = Logger
End 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
'// Module standard: TestModule
Option Explicit
 
Private Const ModuleName As String = "TestModule"
 
Public Sub TestFunction()
On Error Goto Error    '// Gestionnaire d'erreur à déclarer uniquement pour les fonctions de plus haut niveau
    Const FunctionName As String = "TestFunction"
    Dim Logger As ErrorLogger
    Set Logger = Factory.CreateErrorLogger(ModuleName, FunctionName)
 
    SubTest
Exit Sub
Error:
    Stop
End Sub
 
Private Sub SubTest()
    Const FunctionName As String = "SubTest"
    Dim Logger As ErrorLogger
    Set Logger = Factory.CreateErrorLogger(ModuleName, FunctionName)
 
    Dim i As Long
    i = 10 / 0
End Sub

Lors de la destruction de l'instance de la classe ErrorLogger, si une erreur d'exécution a été levée, cette dernière est affichée dans la fenêtre d'exécution. On a alors connaissance de toute la pile des appels.
On sais quelle fonction à levé quelle erreur.
On sais également si l'erreur se transforme (symptôme d'une seconde erreur d'execution levée sur une première).

[Valtrase]

Bonjour à tous,
Je ne vois nulle part où tu sauvegardes le ruban, en général c'est dans la Sub de chargement du ruban.
Je n'utilise pas Mac mais pour ma part voici mon code qui ne me pose pose pas de problème.
Pour les déclarations :

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
#If VBA7 Then
    Public Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, _
                                                                                    ByRef Source As Any, _
                                                                                    ByVal Length As Long)
#Else
    Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, _
                                                                            ByRef Source As Any, _
                                                                            ByVal Length As Long)
#End If
 
#If VBA7 Then
    Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object
#Else
    Function GetRibbon(ByVal lRibbonPointer As Long) As Object
#End If
    Dim RibbonTemp As Object
    CopyMemory RibbonTemp, lRibbonPointer, LenB(lRibbonPointer)
    Set GetRibbon = RibbonTemp
    Set RibbonTemp = Nothing
End Function

Pour la sauvegarde du Handle du ruban avec trois exemples selon la gestion des paramètres qui a été choisi les deux premières nécessites des procédures supplémentaires. La troisième sauvegarde le Handle dans un champ nommé (RibbonHandle) d'une feuille sys_Settings.
Il faut décommenter une des trois lignes selon le cas. (Pour les essais la troisième fera l'affaire. Penser à créer le champ nommé sur la feuille sys_Settings)

Code :

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

1
2
3
4
5
6
7
8
9
10
'@Description "Définit la procédure VBA qui doit être déclenchée lors du chargement du ruban."
Public Sub OnRibbonLoad(Ribbon As IRibbonUI)
    Set mUIRibbon = Ribbon
    mUIRibbon.ActivateTab "tab0"
    ' // Save the Ribbon Handle
'    ExcelProperties.SetProperty "RibbonHandle", CStr(ObjPtr(mUIRibbon)), msoPropertyTypeNumber
'    Settings.SetParams Factory.InitSettingsTab, "RibbonHandle", CStr(ObjPtr(mUIRibbon))
    sys_Settings.Range("RibbonHandle").Value = CStr(ObjPtr(mUIRibbon))
 
End Sub

Maintenant la procédure de récupération du Handle, il faut aussi dé-commenter une ligne selon selon la méthode de sauvegarde sélectionnée.

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
'@Description "Récupère le ruban en cas de perte."
Sub RefreshRibbon(Optional ByVal ControlID As String = "")
    If mUIRibbon Is Nothing Then
        #If VBA7 Then
'            Set mUIRibbon = GetRibbon(CLngPtr(ExcelProperties.GetProperty("RibbonHandle")))
'            Set mUIRibbon = GetRibbon(CLngPtr(Settings(Factory.InitSettingsTab, "RibbonHandle")))
            Set mUIRibbon = GetRibbon(CLngPtr(sys_Settings.Range("RibbonHandle").Value))
        #Else
'            Set mUIRibbon = GetRibbon(CLng(ExcelProperties.GetProperty("RibbonHandle")))
'            Set mUIRibbon = GetRibbon(CLng(Settings(Factory.InitSettingsTab, "RibbonHandle")))
            Set mUIRibbon = GetRibbon(CLng(sys_Settings.Range("RibbonHandle").Value))
        #End If
        If ControlID = vbNullString Then
            mUIRibbon.Invalidate
        Else
            mUIRibbon.InvalidateControl ControlID
        End If
    Else
        If ControlID = vbNullString Then
            mUIRibbon.Invalidate
        Else
            mUIRibbon.InvalidateControl ControlID
        End If
    End If
End Sub

Maintenant , tu dois appeller la procédure refreshribbon à chaque fois que tu fait appel à celui-ci :

Code :

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

1
2
3
4
5
6
 
'...
'...
RefreshRibbon
' Ou pour un contrôle
RefreshRibbon ("Btn_Valider")

Je ne suis que de passage et ne pourrais peut-être pas répondre rapidement aux compléments d'informations.

[patmeziere]

Merci valtraze
ca fonctionne mais au bout de 10 ou 15 fois ça plante excel
je garde ton écriture pour les api
j'ajoute une sub restaureRibbon
et je l'appelle dans les callback des controls sensés agir avec myRibbon.invalidate ( si myRibbon est nothing )



merci pour le coup de main

[Valtrase]

Bonjour,
Je me suis peut-être mal expliqué...

j'ajoute une sub restaureRibbon

Nul besoin de créer une procédure restaure ribbon. Vous avez tout ce qu'il faut dans les exemples donnés plus haut.
Vous devez utiliser la procédure RefreshRibbon avec ou pas de contrôle en paramètre. Si pas de contrôle mis en paramètre tout le ruban sera mis à jour, la procédure se charge aussi de vérifier si le Ruban est à Nothing.
Et pour finir, vous avez la possibilité d'utiliser d'autres contrôles pour le ruban vous évitant de la programmation exemple avec les SplitButtons.

[patmeziere]

re
bonjour valtraze
non j'ai très bien compris le truc
mais la sub restaureribbon est apellée a tout moment ou un callback est déclenché
car dans ces callback je modifie des group en changeant des variable qui vont faire des modif avec des getvisible getlabel etc...
en gros je fait des switch group pour ne voir afficher uniquement les groupes dont j'ai besoin
bon la plus part du temps c'est un ribbon.invalidate


en fait mon code était bon au depart sauf le longptr en trop dans les déclarations d'api
il faudra que je teste quand même avec office 64 sur Win 64
je renouvelle mes remerciements