Excel Makro Index

[lion7123]

Servus zusammen,
hab Euch heute Nachmittag ja versprochen das Ihr nochmal von mir hört ;)

Ich wollte nun für meine Excel Datei die im moment schon über 20 Reiter hat (und es werden noch mehr)
ein Index erstellen.

Dieses Index soll natürlich ganz vorne liegen und alle Reiter der Reihe nach als Hyperlinks aufweisen.

Das hier hab ich bereits bei google gefunden und es erfüllt seinen zweck zum größten Teil:

-------------------------------
Sub Index()
Dim intTab As Integer
Dim tbl As Worksheet
Dim intZeile As Integer

Set tbl = Worksheets.Add(Before:=Worksheets(1))
intZeile = 1
For intTab = 2 To ActiveWorkbook.Worksheets.Count
tbl.Cells(intZeile, 1).Value = Worksheets(intTab).Name
tbl.Cells(intZeile, 1).Hyperlinks.Add _
Anchor:=Cells(intZeile, 1), Address:="", SubAddress:= _
Worksheets(intTab).Name & "!A1", _
ScreenTip:="Klicken Sie auf den Hyperlink", _
TextToDisplay:=Worksheets(intTab).Name
intZeile = intZeile + 1
Next intTab
End Sub
-------------------------------

Sobald ich jedoch einen neuen reiter anlege, muss ich das makro neu starten und er erstellt erneut einen neuen Reiter.

Zu meiner Frage... kann man das irgendwie umgehn? also das sich der Reiter selbst aktualisiert oder das er nach erneutem ausführen des Makros zumindest überschrieben wird?

Das andere wäre aber ich glaube mal nicht das es geht... : wenn im Index in Spalte A bereits 30 Hyperlinks von oben nach unten stehen das er dann in der übernächsten Spalte "C" weiterschreibt.

Vielen Dank schonmal für die Anworten :)

Gruß

[Kuwer]

Hallo Gruß,

füge folgenden Code in das schon vorhandene VBA-Modul der Tabelle mit den Hyperlinks ein (Rechtsklick auf den Reiter > Code anzeigen):

Code:

Private Sub Worksheet_Activate()
  Dim intZeile As Integer
  Dim oWs As Worksheet
  Columns(1).Clear
  For Each oWs In Worksheets
    If oWs.Name <> Me.Name Then
      intZeile = intZeile + 1
      Cells(intZeile, 1).Hyperlinks.Add _
        Anchor:=Cells(intZeile, 1), Address:="", _
        SubAddress:=oWs.Name & "!A1", _
        ScreenTip:="Klicken Sie auf den Hyperlink", _
        TextToDisplay:=oWs.Name
    End If
  Next oWs
End Sub

Gruß Uwe

[Kuwer]

Hallo,

hatte das mit den 30 Zeilen übersehen. Das ist nun auch drin:

Code:

Private Sub Worksheet_Activate()
  Dim intSpalte As Integer, intZeile As Integer
  Dim oWs As Worksheet
  Me.UsedRange.Clear
  intSpalte = 1
  intZeile = 1
  For Each oWs In Worksheets
    If oWs.Name <> Me.Name Then
      Cells(intZeile, 1).Hyperlinks.Add _
        Anchor:=Cells(intZeile, intSpalte), Address:="", _
        SubAddress:=oWs.Name & "!A1", _
        ScreenTip:="Klicken Sie auf den Hyperlink", _
        TextToDisplay:=oWs.Name
      intZeile = intZeile + 1
      If intZeile = 31 Then
        intSpalte = intSpalte + 2
        intZeile = 1
      End If
    End If
  Next oWs
End Sub

Gruß Uwe

[lion7123]

hey Spitze das ding geht einwandfrei :)

lagert der ab einer gewissen anzahl von hyperlinks dann auch in eine andere spalte um?
wenn nich is echt nich schlimm solange er sich automatisch aktualisiert :) *freu*

!!!!!!! Danke dir !!!!!!!

Gruß

[lion7123]

oh hab vergessen zu aktualisieren :) somit hat sich dann die frage auch beantwortet :)

ich nehme an wenn ich statt 31 , 41 eingebe dann würd er ab 41 erst umlagern ?

-------

Edit : habs grad getestet wenn ich die 41 eingeb verlängert er das ganze...

Echt super super Arbeit :) danke nochmals!!!!

Gruß und schönen Abend noch!!!

[lion7123]

Kuwer, könntest du mir bei deinem Code von damals noch was einfügen bitte ? sofern natürlich möglich!

er soll die liste nach dem Alphabet sortieren das wäre mir noch wichtig.
(sofern das überhaupt geht wenn er Sie auf mehrere Spalten aufteilt.)

danke schonmal gruß

[Kuwer]

Hallo,

hier mit Sortierung:

Code:

Private Sub Worksheet_Activate()
  Dim intSpalte As Integer, intZeile As Integer
  Dim intBlock As Integer, intBlockgroesse As Integer
  Dim oWs As Worksheet
  Me.UsedRange.Clear
  intSpalte = 1
  intZeile = 1
  For Each oWs In Worksheets
    If oWs.Name <> Me.Name Then
      Cells(intZeile, 1).Hyperlinks.Add _
        Anchor:=Cells(intZeile, 1), Address:="", _
        SubAddress:=oWs.Name & "!A1", _
        ScreenTip:="Klicken Sie auf den Hyperlink", _
        TextToDisplay:=oWs.Name
      intZeile = intZeile + 1
    End If
  Next oWs
  Columns(1).Sort Cells(1)
  intBlockgroesse = 40
  For intBlock = intBlockgroesse + 1 To intZeile Step intBlockgroesse
    intSpalte = intSpalte + 2
    Cells(intBlock, 1).Resize(intBlockgroesse).Cut Cells(1, intSpalte)
  Next intBlock
End Sub

Gruß Uwe

[lion7123]

Servus, tut mir leid das ich nochmal schreiben muss :(
kann man in dem code verhindern das er die zellen sperrt ?

da sobald ich meinen Blattschutz anmache und gesperrte zellen nicht mehr anwählbar sind er mir eine fehlermeldung bringt das er den code natürlich nich ausführen kann :)
habs versucht mit dem blattschutzeinstellungen zu umgehn aber dein code hat da mehr rechte ;)

Gruß

[Kuwer]

Hallo,

mein Code sperrt keine Zellen und hat auch nichts mit dem Blattschutz zu tun.

Gruß Uwe

[lion7123]

hmm ok... dachte nur weil die zellen in der index datei immer auf gesperrt stehen auch wenn ich vorher den hacken entfernt hab.
dadurch kann natürlich dein code nich aktualisieren da der blattschutz alle betrifft.

aber werd mir dann wohl ein andere makro zum blattschutz aufheben und sperren besorgen müssen... hab auch schon einen neuen Thread dafür mal aufgemacht

danke dir aber

Gruß