Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 16:39:00
ältere VBA Codes automatisch neu strukturieren
20.04.2024 16:36:42
Arbeitsblatt Script auslagern in Modul
20.04.2024 16:28:25
zwei Makro in einem zusammenführen?
20.04.2024 15:30:14
Warum Verweis zeigt Falsch an
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
936to940
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
936to940
936to940
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Arbeitsblattliste-Hyperlinks erstellen-Formatieren

Arbeitsblattliste-Hyperlinks erstellen-Formatieren
22.12.2007 20:17:07
Karl
Hallo,
ich möchte 2 Makros kombinieren, kenne mich in VBA jedoch nicht aus. Es ist mir trotzdem gelungen,
das Makro "Blattliste" aus CHIP 5/2005 mit einem Makro aus dem Herber Forum zu kombinieren
(Zellinhalt in Hyperlink umwandeln) - dies funktioniert auch ausgezeichnet. Das Gesamtmakro wollte ich mit einem von mir aufgezeichneten Makro zusammenfügen (nur zwecks Formatierung), leider ohne
Erfolg. Mein Ziel ist es ...
1. Aus sämtlichen Tabellenblättern einer Arb.Mappe ein Inhaltsverzeichnis erstellen zu lassen
2. Die Namen der Tabellenblätter im neu erzeugten Blatt "Inhalt" automatisch in Hyperlinks umwandeln
zu lassen und
3. Blatt "Inhalt" zu formatieren (Blattnamen etwas nach rechts verschieben, Rahmen hinzufügen, etc.)
Pkt. 1 u. 2 sind praktisch erledigt - ich möchte jedoch auch Pkt. 3 miteinbeziehen und wäre für Hilfe sehr dankbar. Die beigefügte Arb.Mappe beinhaltet das Makro und zeigt das von mir gewünschte Ergebnis.
Danke im voraus für die Hilfe. tuska https://www.herber.de/bbs/user/48605.xls

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Arbeitsblattliste-Hyperlinks erstellen-Formatieren
22.12.2007 20:56:11
Josef
Hallo Karl,
das sollte genügen.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Sub Blattliste()
Dim objWs As Worksheet, objIndex As Worksheet
Dim lngI As Long

On Error Resume Next
Application.DisplayAlerts = False
Sheets("INHALT").Delete
Application.DisplayAlerts = True
On Error GoTo 0

If objIndex Is Nothing Then
    Set objIndex = Worksheets.Add(before:=Sheets(1))
    With objIndex
        .Name = "INHALT"
        .Columns.ColumnWidth = 7
        .Cells(3, 3) = "Inhaltsverzeichnis (Strg + i)"
        .Cells(3, 4) = "Titel"
        .Cells(3, 5) = "Anmerkung"
        .Columns(2).HorizontalAlignment = xlCenter
        .Columns(3).ColumnWidth = 33
        .Columns(4).ColumnWidth = 33
        .Columns(5).ColumnWidth = 33
        
        With .Range("C3:E3")
            .BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
        End With
    End With
    ActiveWindow.DisplayGridlines = False
End If

For Each objWs In ThisWorkbook.Worksheets
    If Not objWs Is objIndex Then
        lngI = lngI + 1
        With objIndex
            .Cells(lngI + 3, 2) = lngI
            .Hyperlinks.Add Anchor:=.Cells(lngI + 3, 3), _
                Address:="", _
                SubAddress:="'" & Replace(objWs.Name, "'", "''") & "'!A1", _
                TextToDisplay:=objWs.Name
        End With
    End If
Next

With objIndex.Range("C3:E" & lngI + 3)
    .BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End With

Set objIndex = Nothing
Set objWs = Nothing
End Sub

Gruß Sepp

Anzeige
AW: Arbeitsblattliste-Hyperlinks erstellen-Formatieren
22.12.2007 22:25:34
Karl
Hallo Josef,
Vielen Dank für diese Lösung, es ist genau das, was ich mir vorgestellt habe.
Es gibt leider noch ein kleines Problem: Makros aus einer geöffneten Arbeitsmappe kann ich normalerweise auch in anderen Arbeitsmappen verwenden, in diesem Fall erhalte ich aber in einer Arbeitsmappe in der das Makro nicht vorhanden ist auf dem Blatt Inhalt immer die Arbeitsblattliste
von der Datei "xls-Blattliste_Makro.xls" und nicht die Blattliste von der gerade geöffneten Datei.
Das würde für mich bedeuten, daß es noch einen kleinen wesentlichen Unterschied gibt zwischen dem Makro "Blattliste", das sich in meiner Arbeitsmappe befindet und Deinem Makro.
Bitte falls Du Dir das nochmals anschauen könntest. Danke und liebe Grüße ... Karl

Anzeige
AW: Arbeitsblattliste-Hyperlinks erstellen-Formatieren
22.12.2007 22:43:00
Josef
Hallo Karl,
ändere die Zeile

For Each objWs In ThisWorkbook.Worksheets


ab in


For Each objWs In ActiveWorkbook.Worksheets


Gruß Sepp

AW: Arbeitsblattliste-Hyperlinks erstellen-Formatieren
22.12.2007 23:01:00
Karl
Hallo Josef,
es hat funktioniert ! Genial !
Ich möchte jetzt nicht unverschämt werden - nur noch eine letzte Frage und Bitte:
Könnte man folgendes noch einbauen ...
a) Der Cursor soll nach dem erstellen des Blattes Inhalt in die Zelle C3 springen
(dzt. bleibt der Cursor auf dem letzten Eintrag/Arbeitsblatt-Titel stehen und bei vielen Tabellen
würde somit die Bildschirmansicht nach unten scrollen - dies wäre nicht wünschenswert)
b) Mit Strg + i sollte man von jedem Arbeitsblatt auf das Blatt Inhalt in Zelle C3 springen können
erleichtert Navigation - (mit auto_open Makroaufzeichnung wäre das auch möglich, aber
vielleicht kannst Du das noch einbauen - das wäre dann optimal.
Auch wenn Du diese beiden Punkte nicht mehr lösen würdest bedanke ich mich ganz ganz herzlich
bei Dir. Liebe Grüße ... Karl

Anzeige
AW: Arbeitsblattliste-Hyperlinks erstellen-Formatieren
22.12.2007 23:09:00
Karl
Hallo Josef,
ein wichtiger Punkt ist mir gerade noch aufgefallen:
Falls bereits ein Blatt INHALT existiert, dann sollte dieses keinesfalls überschrieben werden
sondern es sollte ein Blatt mit einem anderen Namen, zB INHALTneu, etc. erstellt werden.
IdR richtet man sich ein Inhaltsverzeichnis nach seinen Wünschen her und es wäre schade,
wenn diese uU zeitaufwändige Arbeit einmal ungewollt zunichte gemacht werden würde.
Liebe Grüße ... Karl

AW: Arbeitsblattliste-Hyperlinks erstellen-Formatieren
22.12.2007 23:29:00
Josef
Hallo Karl,
das angepasste Makro.
Sub Blattliste()
Dim objWs As Worksheet, objIndex As Worksheet
Dim lngI As Long, n As Integer
Dim strName As String, strNumber

strName = "INHALT"

On Error Resume Next

Set objIndex = Sheets(strName)
If Not objIndex Is Nothing Then
    Do
        Set objIndex = Nothing
        n = n + 1
        strNumber = Format(n, " 00")
        Set objIndex = Sheets(strName & strNumber)
    Loop While Not objIndex Is Nothing
End If

On Error GoTo ErrExit

Application.ScreenUpdating = False

Set objIndex = Worksheets.Add(before:=Sheets(1))
With objIndex
    .Name = strName & strNumber
    .Columns.ColumnWidth = 7
    .Cells(3, 2) = "Nr."
    .Cells(3, 3) = "Inhaltsverzeichnis (Strg + i)"
    .Cells(3, 4) = "Titel"
    .Cells(3, 5) = "Anmerkung"
    .Columns(2).HorizontalAlignment = xlCenter
    .Columns(3).ColumnWidth = 33
    .Columns(4).ColumnWidth = 33
    .Columns(5).ColumnWidth = 33
    
    With .Range("B3:E3")
        .BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
End With
ActiveWindow.DisplayGridlines = False

For Each objWs In ActiveWorkbook.Worksheets
    If Not objWs Is objIndex Then
        lngI = lngI + 1
        With objIndex
            .Cells(lngI + 3, 2) = lngI
            .Hyperlinks.Add Anchor:=.Cells(lngI + 3, 3), _
                Address:="", _
                SubAddress:="'" & Replace(objWs.Name, "'", "''") & "'!A1", _
                TextToDisplay:=objWs.Name
        End With
    End If
Next

With objIndex.Range("B4:E" & lngI + 3)
    .Font.Underline = False
    .BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End With
ActiveWindow.ScrollRow = 1
objIndex.Range("C3").Activate
ErrExit:
Application.ScreenUpdating = True
Set objIndex = Nothing
Set objWs = Nothing
End Sub

Gruß Sepp

Anzeige
AW: Arbeitsblattliste-Hyperlinks erstellen-Formatieren
22.12.2007 23:13:00
Josef
Hallo Karl,
aufpassen welcher Code wo eingefügt werden muss.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnKey "^i"
End Sub

Private Sub Workbook_Open()
Application.OnKey "^i", "JumpToIndex"
End Sub

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Sub Blattliste()
Dim objWs As Worksheet, objIndex As Worksheet
Dim lngI As Long

On Error Resume Next
Application.DisplayAlerts = False
Sheets("INHALT").Delete
Application.DisplayAlerts = True
On Error GoTo ErrExit

Application.ScreenUpdating = False

Set objIndex = Worksheets.Add(before:=Sheets(1))
With objIndex
    .Name = "INHALT"
    .Columns.ColumnWidth = 7
    .Cells(3, 2) = "Nr."
    .Cells(3, 3) = "Inhaltsverzeichnis (Strg + i)"
    .Cells(3, 4) = "Titel"
    .Cells(3, 5) = "Anmerkung"
    .Columns(2).HorizontalAlignment = xlCenter
    .Columns(3).ColumnWidth = 33
    .Columns(4).ColumnWidth = 33
    .Columns(5).ColumnWidth = 33
    
    With .Range("B3:E3")
        .BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
End With
ActiveWindow.DisplayGridlines = False

For Each objWs In ActiveWorkbook.Worksheets
    If Not objWs Is objIndex Then
        lngI = lngI + 1
        With objIndex
            .Cells(lngI + 3, 2) = lngI
            .Hyperlinks.Add Anchor:=.Cells(lngI + 3, 3), _
                Address:="", _
                SubAddress:="'" & Replace(objWs.Name, "'", "''") & "'!A1", _
                TextToDisplay:=objWs.Name
        End With
    End If
Next

With objIndex.Range("B4:E" & lngI + 3)
    .Font.Underline = False
    .BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End With
ActiveWindow.ScrollRow = 1
objIndex.Range("C3").Activate
ErrExit:
Application.ScreenUpdating = True
Set objIndex = Nothing
Set objWs = Nothing
End Sub

Sub JumpToIndex()
On Error Resume Next
ActiveWorkbook.Sheets("INHALT").Activate
Sheets("INHALT").Range("C3").Activate
On Error GoTo 0
End Sub

Gruß Sepp

Anzeige
AW: Arbeitsblattliste-Hyperlinks erstellen-Formatieren
22.12.2007 23:33:53
Karl
Hallo Josef,
der Cursor springt jetzt wunschgemäß nach Erstellung des Inh.Verzeichnisses in Zelle C3.
Offen bleiben für mich jetzt nur die folgenden 2 Punkte:
1. Das Blatt INHALT wird nach jedem Makroaufruf ohne Vorwarnung überschrieben.
2. Wenn ich mich auf irgendeinem Arbeitsblatt befinde, wollte ich mit Strg + i
zum Inhaltsverzeichnis wechseln. (Den 2. Pkt. kann ich ohne weitere Aufwände von Dir
mit dem auto_open Makro aufzeichnen) Ich denke, da brauchst Du Dich nicht weiter zu bemühen.
Eigentlich verursacht mir nur das autom. Überschreiben des Inh.Verz. Unbehagen.
Vielleicht könntest Du bitte nochmals mit dem Makro in meiner Ursprungsarb.Mappe vergleichen.
Dieses überschreibt das Inhaltsverz. nicht.
Bei dieser Gelegenheit möchte ich Dir sagen, daß ich von Dir schwer beeindruckt bin.
Kaum schreibt man im Forum eine Frage - schon hat man die Antwort !!
Liebe Grüße ... Karl

Anzeige
AW: Arbeitsblattliste-Hyperlinks erstellen-Formatieren
22.12.2007 23:38:06
Josef
Hallo Karl,
auch der Zweite Punkt sollte funktionieren, wenn du den gesamten Code an die Jeweils richtigen Stellen kopiert hast.(Du musst allerdings die Datei speichern, schliessen und wieer öffnen, damit die Tastenkombination funktioniert).
Zum Überschreiben siehe: https://www.herber.de/forum/messages/936795.html
Gruß Sepp

AW: Arbeitsblattliste-Hyperlinks erstellen-Formatieren
22.12.2007 23:40:34
Karl
Hallo Josef,
jetzt habe ich leider gerade übersehen, daß Du das Makro Blattliste bereits überarbeitet hast.
Es funktioniert ganz ausgezeichnet und deckt meine Wünsche zur Gänze ab.
Nochmals vielen herzlichen Dank für Deine rasche und hervorragende Unterstützung !
Liebe Grüße
Karl
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige