Navigationslogik

[StrammerMax]

Hallo zusammen,

ich habe hier eine Arbeitsmappe, die zu Beginn nur 3 Arbeitsblätter hat. 
Diese Datei wird an unterschiedliche Adressaten verteilt, die dann bis zu 30 Blätter hinzufügen und die Blattreiter alle unterschiedlich benennen. 

Bei 30 Arbeitsblättern, die teilweise lange Namen haben ist die Navigation zwischen den Blättern recht umständlich. 

Angedacht ist nun eine Navigation auf jedem Blatt, die alle Blätter der Arbeitsmappe anzeigt. Wenn ein Blatt hinzugefügt wird muss es in der Navigationsliste ebenfalls hinzugefügt werden. Wird eines gelöscht muss es aus der Navigation fallen. Die Blätter sollen in der Navigation in der richtigen Reihenfolge dargestellt werden. Sprich erstes Blatt (ganz links) steht in der Navigation ganz oben. 
Das jeweils ausgewählte Blatt soll in der Navigation farblich hinterlegt / markiert werden. 


Weiß jemand, ob solch eine Logik schon irgendwo existiert?

[shift-del]

Weiß jemand, ob solch eine Logik schon irgendwo existiert?

Es gibt verschiedene Add-Ins. Möglicherweise nicht ganz umsonst.

[Elex]

Hi

Links unten hast du die Pfeile für die Blatt Navigation. Klick auf einen Pfeil mal mit der rechten Maus Taste. Einfacher wird es als Nachbau auch nicht werden.

Gruß Elex

[Klaus-Dieter]

Hallo,

so etwas?

Code:

Private Sub Workbook_Open()
Dim Blatt As Object
For Each Blatt In ActiveWorkbook.Sheets
    Z = Z + 1
    Tabelle1.Cells(Z, 1) = Blatt.Name  ' Zieltabelle anpassen
Next Blatt
End Sub

kommt in das Modul der Arbeitsmappe.

[StrammerMax]

Es gibt verschiedene Add-Ins. Möglicherweise nicht ganz umsonst

Muss dann nicht jeder der Nutzer dieses Add-in installieren?

---

Hi

Links unten hast du die Pfeile für die Blatt Navigation. Klick auf einen Pfeil mal mit der rechten Maus Taste. Einfacher wird es als Nachbau auch nicht werden.

Gruß Elex

Mir persönlich würde das auch ausreichen... aber es soll trotzdem sowas nachgebaut werden.

[shift-del]

Muss dann nicht jeder der Nutzer dieses Add-in installieren?

Natürlich.

[StrammerMax]

Hallo,

so etwas?

Code:

Private Sub Workbook_Open()
Dim Blatt As Object
For Each Blatt In ActiveWorkbook.Sheets
    Z = Z + 1
    Tabelle1.Cells(Z, 1) = Blatt.Name  ' Zieltabelle anpassen
Next Blatt
End Sub

kommt in das Modul der Arbeitsmappe.

Nein - dein Code listet einfach nur die vorhandenen Arbeitsblätter auf und schreibt sie auf das erste Blatt. 
Er aktualisiert sich nicht automatisch, er bietet keinerlei Navigationsmöglichkeit, er highlighted nicht das ausgewählte Blatt und er zeigt die Auswahl nicht auf jedem Blatt an.

---

Natürlich.

Und damit fällt die Lösung schon mal raus... Die Datei geht an ca. 100 Adressaten die auf der ganzen Welt verstreut sitzen... meinst du die werden alle ein (kostenpflichtiges) Add-in installieren?

[Klaus-Dieter]

Hallo,

Er aktualisiert sich nicht automatisch

stimmt so nicht, so wie es jetzt ist, aktualisiert er sich immer wenn die Datei geöffnet wird. Mit der Option SheetChange, würde das bei jeder Änderung auf einem Blatt erfolgen. Hyperlinks kann man damit auch generieren. Es hilft doch niemand, wenn man immer Maßgeschneiderte Lösungen präsentiert. Ein wenig eigenen Einsatz kann man als Fragesteller ruhig einbringen.

[Wastl]

Moin,

Kruschtel in der Ablage (erst letztes Jahr auf Office 365 angewendet, tut also)
Nur dynamisch isses nicht, aber das können die Cracks hier sicherlich ändern

Code:

Sub Hypalle()
'
' Hypalle Makro
' Makro am 08.04.2008 von rkoehle aufgezeichnet
'

'
Dim i As Long, k As Long, l As Long, Blattname As Variant

   ActiveWorkbook.Names.Add Name:="Alle", RefersToR1C1:= _
       "=Get.Workbook(1+0*NOW())"
For i = 1 To ActiveWorkbook.Sheets.Count
 If Sheets(i).Name = "Inhalt" Then
   k = k + 1
 Else
   Worksheets(i).Activate
   Call Inhalt_zurueck
 End If
Next i
Sheets.Add
If k = 0 Then
 ActiveSheet.Name = "Inhalt"
Else
 ActiveSheet.Name = "Inhalt " & ActiveWorkbook.Sheets.Count + 1
End If
Blattname = ActiveSheet.Name
Sheets(Blattname).Move after:=Sheets(Sheets.Count - 1)

l = ActiveWorkbook.Sheets.Count + 10
[A1] = "Enthaltene Blätter"
[A1].Interior.Color = RGB(200, 200, 200)
[A1].Font.Bold = True


Sheets(Blattname).Cells(2, 1).FormulaLocal = "=WENN(ZEILE(A1)>ANZAHL2(Alle);"""";HYPERLINK(""#'""&INDEX(Alle;ZEILE(A1))&""'!A1"";TEIL(INDEX(Alle;ZEILE(A1));FINDEN(""]"";INDEX(Alle;ZEILE(A1)))+1;31)))"
Range("A2:A" & l).FillDown
   With Range("A2:A" & l).Validation
       .Delete
       .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _
       xlBetween, Formula1:="=now()"
       .IgnoreBlank = True
       .InCellDropdown = True
       .InputTitle = "Hyperlink"
       .ErrorTitle = "Fähler"
       .InputMessage = "Bei Klick auf den Namen öffnet sich das Blatt"
       .ErrorMessage = "Stopp!"
       .ShowInput = True
       .ShowError = True
   End With
   With Cells.Font
       .Name = "CorpoS"
       .Size = 14
       .Strikethrough = False
       .Superscript = False
       .Subscript = False
       .OutlineFont = False
       .Shadow = False
       .Underline = xlUnderlineStyleNone
       .ColorIndex = xlAutomatic
   End With

Columns(1).AutoFit
Range("C1:IV1").EntireColumn.Hidden = True
[b2].Value = "Klick auf die Spalte A"
[B3].Value = "öffnet entsprechendes"
[B4].Value = "Blatt."
[B6].Value = "Zurück kommt man über"
[B7].Value = "Klick auf Zelle A1"
'[B8].Value = "(außer bei USA),"
[B9].Value = "also die Überschrift!"
Columns(2).AutoFit

Range("A" & l & ":A65536").EntireRow.Hidden = True
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="maky"
ActiveWorkbook.Sheets(Blattname).Tab.ColorIndex = 3
End Sub

Sub Inhalt_zurueck()
On Error Resume Next
Dim A1 As Variant
A1 = Cells(1, 1)
Range("A1").FormulaLocal = "=WENN(ZEILE(A1)>ANZAHL2(Alle);"""";HYPERLINK(""#Inhalt!A1"";" & """" & A1 & """" & "))"
End Sub

[Elex]

Hi

Mir persönlich würde das auch ausreichen... aber es soll trotzdem sowas nachgebaut werden.

Verwette meinen Ars… das es auch den anderen reichen würde wenn sie es kennen würden.
 
In jedem Blatt eine Liste der Blätter!  Das ganze wird ein Nachbau der keine Vorteile bringt aber die Navigation im Blatt selbst verkompliziert. Oder haben die Blätter gar keine Daten?

Aber jeder wie er mag.

Gruß