Zeitverzögerte Aktualisierung des Ribbons
25.04.2015 17:16:04
SteffenS
ich habe in meinem "Projekt" mehrere Arbeitsmappe welche ich durch ein Ribbon steuere. Das Ribbon ist so aufgebaut, dass ich dieser per get-Anweisung während der Laufzeit verändern kann. Dies funktioniert soweit auch super.
Das einzige Problem ist, dass die Aktualisierung bis zu 2 Sekunden dauert. Als Ursache habe ich ausgemacht, dass dies an der Neuberechnung der Arbeitsmappen liegt.
Im Detail liegt dies an einer Mappe die über einige WVERWEIS-Formeln verfügt.
Bei der Aktualisierung des Ribbons mit Hilfe des nachfolgenden Codes wird aber gar keine Neuberechnung ausgeführt. Setze ich die Berechnung auf manuell geht es deutlich schneller. Bei der Umstellung auf automatic erfolgt dann wieder die Berechnung und es dauert genaus so lang.
Habe schon einmal die Berechnung vor der Aktualisierung auf manuell gestellt und danach wieder auf automati - ohne Erfolg.
Habt ihr noch eine Idee was ich tun kann?
Const NAMES_NAME = "Ribbon"
'--------------------------------------------------------------------------------------
'Speicherung des Ribbons, damit dieser bei Fehlern nicht verloren geht
'--------------------------------------------------------------------------------------
#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
Public gobjRibbon As IRibbonUI
'-------------------------------------------------------------------------------------------------------------------
'Ribbon initialisieren, damit Änderungen während der Laufzeit möglich sind
'-------------------------------------------------------------------------------------------------------------------
Public Sub OnLoadRibbon(pobjRibbon As IRibbonUI)
Dim objName As Name
Set gobjRibbon = pobjRibbon
ThisWorkbook.Names.Add Name:=NAMES_NAME, RefersTo:=CStr(ObjPtr(pobjRibbon)), Visible:=False
End Sub
'-------------------------------------------------------------------------------------------------------------------'Sicherstellen das Refreh immer möglich ist
'-------------------------------------------------------------------------------------------------------------------
#If VBA7 Then
Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object
#Else
Function GetRibbon(ByVal lRibbonPointer As Long) As Object
#End If
Dim objRibbon As Object
Call CopyMemory(objRibbon, lRibbonPointer, LenB(lRibbonPointer))
Set GetRibbon = objRibbon
Set objRibbon = Nothing
End Function
Sub RefreshRibbon()
Dim objName As Name
If gobjRibbon Is Nothing Then
For Each objName In ThisWorkbook.Names
If objName.Name = NAMES_NAME Then
#If VBA7 Then
Set gobjRibbon = GetRibbon(CLngPtr(Mid$(objName.RefersTo, 2)))
#Else
Set gobjRibbon = GetRibbon(CLng(Mid$(objName.RefersTo, 2)))
#End If
Exit For
End If
Next
Set objName = Nothing
gobjRibbon.Invalidate
Else
gobjRibbon.Invalidate
End If
End Sub
'--------------------------------------------------------------------------------------
VG Steffen Schmerler