Ribbon Problem Aktivierung

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Ribbon Problem Aktivierung
von: Ludmila
Geschrieben am: 21.11.2015 14:41:51

Hallo Spezialisten,
wenn ich manuell die einzelnen Tabellenblätter aktiviere, wird das
zugehörige Ribbon (je Tabellenblatt) angezeigt.
In der Arbeitsmappe sind 4 fixe Blätter vorhanden.
Wenn ich jedoch, wie im nachfolgenden Code, ein Tabellenblatt einfüge,
dann wird das Ribbon nicht aktiviert.
Die geschieht erst wenn ich ein anderes Tabellenblatt aktiviere und dann
wie im Beispiel auf Regiebericht zurück gehe, dann erschein auch das zugehörige
Ribbon.
Danke!
Gruß
Ludmila
Diese Arbeitsmappe

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

StandardModule: Modul1
Option Private Module
Option Explicit
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_Tab_Start_2016(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
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

Bild

Betrifft: AW: Ribbon Problem Aktivierung
von: mumpel
Geschrieben am: 21.11.2015 16:43:13
Hallo!
Versuch es mal mit Workbook_NewSheet.
Gruß, René

Bild

Betrifft: AW: Ribbon Problem Aktivierung
von: Ludmila
Geschrieben am: 22.11.2015 02:30:46
Hallo Rene,
das funktioniert.
Danke!
Gruß
Ludmila

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Ribbon Problem Aktivierung"