Navigationslogik

[StrammerMax]

Es ist aber einfacher etwas nachzubauen, das direkt auf dem Blatt ist - als 100 Leuten die Funktion zu zeigen, wie man durch die Reiter scrollen kann.

---

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

Das ist genial - tausend Dank :)