Ribbon Problem
07.12.2015 00:11:21
Olga
habe ein Problem mit meinem Ribbon.
Es erscheint ständig Laufzeitfehler 91.
Warum?
Die Arbeitsmappe hat mehere TB welche jedoch kein Ribbon haben.
Danke!
Gruß
Olga
Im UI Editor:
In dieser Arbeitsmappe:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call RefreshRibbon
objRibbon.Invalidate
End Sub
Option Private Module
Option Explicit
Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd As Long)
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard& Lib "user32" ()
Public objRibbon As IRibbonUI
Public TabOnSheet1 As Boolean
#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
Private Const NAME_RIBBON = "Ribbon"
Public Sub Onload_Menu(pobjRibbon As IRibbonUI)
Set objRibbon = pobjRibbon
Thisworkbook.Names.Add Name:=NAME_RIBBON, RefersTo:=CStr(ObjPtr(pobjRibbon)), Visible:= _
False
End Sub
#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 objRibbon Is Nothing Then
For Each objName In Thisworkbook.Names
If objName.Name = NAME_RIBBON Then
#If VBA7 Then
Set objRibbon = GetRibbon(CLngPtr(Mid$(objName.RefersTo, 2)))
#Else
Set objRibbon = GetRibbon(CLng(Mid$(objName.RefersTo, 2)))
#End If
Exit For
End If
Next
Set objName = Nothing
objRibbon.Invalidate
Else
objRibbon.Invalidate
End If
End Sub
Public Sub getVisible_Tab1(control As IRibbonControl, ByRef returnValue)
On Error Resume Next
If ActiveSheet.Name = control.ID Then
returnValue = True
objRibbon.ActivateTab (control.ID)
End If
On Error GoTo 0
End Sub
Public Sub Zwischenablage_leeren()
OpenClipboard 0&
EmptyClipboard
CloseClipboard
End Sub
Private Sub Workbook_NewSheet()
Call RefreshRibbon
objRibbon.Invalidate
End Sub
Private Sub Worksheet_Delete()
On Error Resume Next
For Each wks In Thisworkbook.Sheets
If wks.Name "Menu" And wks.Name "Data" And wks.Name "RG_Journal" And wks.Name _
"NK" And wks.Name "Kunden" And wks.Name "Projekt" Then wks.Delete
Next
With Thisworkbook.Worksheets("Menu")
.Select
End With
Call RefreshRibbon
objRibbon.Invalidate
End Sub
