Ribbon Problem Aktivierung

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call RefreshRibbon
objRibbon.Invalidate
End Sub

Public Sub Onload_Tab_Start_2016(pobjRibbon As IRibbonUI)
Set objRibbon = pobjRibbon
ThisWorkbook.Names.Add Name:=NAME_RIBBON, RefersTo:=CStr(ObjPtr(pobjRibbon)), Visible:= _
False
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

Private Sub Regie_oeffnen_xls() 'Regiebericht in Arbeitsmappe einlesen
Dim sZnrKDNR As String
Dim sZnrProjNr As String
Dim sRegieNr As String
Dim sBTNr As String
Dim wksProj As Worksheet
Dim wksKD As Worksheet
Dim wksNK As Worksheet
Dim wksUeber As Worksheet
Dim wksRegie As Worksheet
Dim sPath As String
Dim sPfad As String
Dim sFile As String
Dim wkb As Object
Dim bAltNeuBT As Boolean
With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
End With
If UF1.cboRegie_Ornder_xls.Value = "" Then
MsgBox "Sie haben keine" & vbNewLine & _
"Datei" & vbNewLine & _
"ausgewählt..."
Exit Sub
End If
On Error GoTo ERRORHANDLER
'Eintragung des Speicherpfades in Regiebericht
sPfad = ThisWorkbook.Path & "\Firma\" & UF1.cboAGName.Value & "\" & UF1.cboAGProjekt.Value & _
"\" & "Regiebericht\"
sFile = UF1.cboRegie_Ornder_xls.Value
Set wksKD = ThisWorkbook.Worksheets("Kunden")
Set wksProj = ThisWorkbook.Worksheets("Projekt")
Set wksUeber = ThisWorkbook.Worksheets("Übersicht")
'Bestehenden Regiebericht bearbeiten
If sFile  "Regiebericht Neu" Then GoTo Weiter01
'Neuen Regiebericht erstellen
If sFile = "Regiebericht Neu" Then
sPath = ThisWorkbook.Path & "\Firma\Arbeitsdateien\"
sFile = "Regiebericht_leer.xlsm"
If FileExists(sPath & sFile) = False Then
MsgBox "Die Datei" & vbNewLine & _
sFile & vbNewLine & _
"wurde nicht gefunden..." & vbNewLine & _
"Bitte Verzeichnis prüfen!" & vbNewLine & _
"Der Regiebericht muß im Verzeichnis" & vbNewLine & _
"Firma, Arbeitsdateien" & vbNewLine & _
"abgelegt sein..."
Exit Sub
Else
Set wkb = Workbooks.Open(sPath & sFile, False)
End If
End If
On Error GoTo ERRORHANDLER
With ThisWorkbook
wkb.Worksheets("Regiebericht").Copy After:=.Worksheets(.Worksheets.Count)
End With
wkb.Close savechanges:=False
'Kunden suchen für Eintrag in Regiebericht
With wksKD
For ii = 2 To .Cells(Rows.Count, 7).End(xlUp).Row
If .Cells(ii, 7) = UF1.lblAGKDNR.Caption Then
sZnrKDNR = ii
Exit For
End If
Next ii
End With
'Im Projekt Regieberichtsnummer suchen
With wksProj
For ii = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
If .Cells(ii, 2) = UF1.lblProjNr.Caption Then
sZnrProjNr = ii
bytSpalte = .Rows(1).Find(what:="DB_PROJ_REGIE_NR", LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows).Column
sRegieNr = .Cells(sZnrProjNr, bytSpalte) + 1
bytSpalte = .Rows(1).Find(what:="DB_PROJ_NR", LookIn:=xlValues, lookat:=xlWhole,  _
SearchOrder:=xlByRows).Column
sBTNr = .Cells(sZnrProjNr, bytSpalte)
End If
Next ii
End With
Set wksRegie = ThisWorkbook.Worksheets("Regiebericht")
With wksRegie
.Cells(1, 13) = sPfad 'Hier wird der Speicherpfad eingetragen
.Cells(2, 13) = sBTNr 'Projektnummer
.Cells(4, 3) = sRegieNr 'Regieberichtnummer
.Cells(5, 3) = Date
.Cells(8, 2) = wksKD.Cells(sZnrKDNR, 8) 'Kundendaten
.Cells(9, 2) = wksKD.Cells(sZnrKDNR, 2)
.Cells(10, 2) = wksKD.Cells(sZnrKDNR, 3)
.Cells(11, 2) = wksKD.Cells(sZnrKDNR, 5)
.Cells(12, 2) = wksKD.Cells(sZnrKDNR, 6)
.Cells(8, 7) = wksProj.Cells(sZnrProjNr, 8) 'Projektdaten
.Cells(9, 7) = wksProj.Cells(sZnrProjNr, 6)
.Cells(10, 7) = wksProj.Cells(sZnrProjNr, 7)
.Cells(11, 7) = "Bauleitung " & wksProj.Cells(sZnrProjNr, 9)
End With
bAltNeuRegie = True
GoTo Ende
Weiter01:
sPath = ThisWorkbook.Path & "\Firma\" & UF1.cboAGName.Value & "\" & UF1.cboAGProjekt.Value & " _
\" & "Regiebericht\"
sFile = UF1.cboRegie_Ornder_xls.Value
If FileExists(sPath & sFile) = False Then
MsgBox "Die Datei" & vbNewLine & _
sFile & vbNewLine & _
"wurde nicht gefunden..." & vbNewLine & _
"Bitte Verzeichnis prüfen!" & vbNewLine & _
"Der Regiebericht muß im Verzeichnis" & vbNewLine & _
"Firma" & vbNewLine & _
UF1.cboAGName & vbNewLine & _
UF1.cboAGProjekt & vbNewLine & _
"abgelegt sein..."
Exit Sub
Else
Set wkb = Workbooks.Open(sPath & sFile, False)
End If
On Error GoTo ERRORHANDLER
With ThisWorkbook
wkb.Worksheets("Regiebericht").Copy After:=.Worksheets(.Worksheets.Count)
End With
wkb.Close savechanges:=False
bAltNeuRegie = False
Ende:
With UF1
.Mpl1.Value = 9 'Auf Start setzen damit beim erneuten Aufruf die neue Datei eingelsene wird
.Hide
End With
With wksUeber 'Angabe wegen spätern speichern der Datei, bzw. hochzählen der  _
Regieberichtnummer
.Select 'nur wegen Ribbon ?
.Cells(1, 1) = "Regiebericht"
If bAltNeuRegie = True Then
.Cells(2, 1) = "Neu"
Else
.Cells(2, 1) = "Alt"
End If
End With
Set wksRegie = ThisWorkbook.Worksheets("Regiebericht")
With wksRegie
.Select
.Cells(1, 1).Select
End With
ERRORHANDLER:
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Public Function FileExists(ByVal strFile As String) As Boolean
On Error Resume Next
FileExists = IIf(Dir(strFile)  "", True, False)
End Function