Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.


Excel Makro Index
#1
Servus zusammen,
hab Euch heute Nachmittag ja versprochen das Ihr nochmal von mir hört Wink

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 Smile

Gruß
to top
#2
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
to top
#3
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
[-] Folgende(r) 1 Benutzer sagt Danke an Kuwer für diesen Beitrag:
lion7123
to top
#4
hey Spitze das ding geht einwandfrei Smile

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 Smile *freu*

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

Gruß
to top
#5
oh hab vergessen zu aktualisieren Smile somit hat sich dann die frage auch beantwortet Smile

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 Smile danke nochmals!!!!

Gruß und schönen Abend noch!!!
to top
#6
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ß
to top
#7
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
[-] Folgende(r) 1 Benutzer sagt Danke an Kuwer für diesen Beitrag:
lion7123
to top
#8
Servus, tut mir leid das ich nochmal schreiben muss Sad
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 Smile
habs versucht mit dem blattschutzeinstellungen zu umgehn aber dein code hat da mehr rechte Wink

Gruß
to top
#9
Hallo,

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

Gruß Uwe
to top
#10
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ß
to top


Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  Sortieren mit Makro ohne Überschrift Excel 2003 Babsi 0 12 Vor 1 Stunde
Letzter Beitrag: Babsi
  Schwieriges Problem | Index & Verweis Auswertung excelhexel 2 50 30.11.2016, 20:09
Letzter Beitrag: excelhexel
  Index (Vergleichsbefehl) mit mehreren Variablen? Franzi 79 5 101 21.10.2016, 22:31
Letzter Beitrag: Jockel
  Excel Makro Papafirefest 8 220 19.10.2016, 10:26
Letzter Beitrag: Peter
  Index Formel nach rechts ziehen und dabei Spalte fixieren Gwendolyn 2 149 30.09.2016, 19:28
Letzter Beitrag: schauan
  Excel Makro oder Verknüpfungen? freeloader1986 5 177 29.09.2016, 13:20
Letzter Beitrag: freeloader1986
  Exceldatei mit anderer Excel Datei komplett ersetzen Makro BadHabiit 8 257 25.09.2016, 16:36
Letzter Beitrag: schauan
  Excel mit Makro in den Vordergrund bringen Tim1711 3 233 12.08.2016, 09:08
Letzter Beitrag: Tim1711
  Makro für INDEX VERGLEICH Funktion Felixk 6 305 03.08.2016, 11:06
Letzter Beitrag: Felixk
  Index mit mehreren Kriteien sirphilipp 1 210 30.06.2016, 14:01
Letzter Beitrag: BoskoBiati

Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste