VBA-Code von Werner => Leerzeichen akzeptieren
29.05.2017 10:23:35
Werner
Hi Werner,
hab eine kurze Frage zu deinem VBA-Code aus der 1. Version (also die Version vor der Userform-Version, die Matthias ergänzt hat):
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim raBereich As Range
Dim raZelle As Range
Dim loLetzte As Long
Dim i As Long
Dim ws As Worksheet
'Abbruch wenn ActiveSheet kein WorkSheet ist
If TypeName(ActiveSheet) "Worksheet" Then Exit Sub
i = 3
Application.ScreenUpdating = False
With ActiveSheet
loLetzte = .Cells(.Rows.Count, 2).End(xlUp).Row
Set raBereich = .Range(.Cells(3, 1), .Cells(loLetzte, 2))
raBereich.ClearContents
End With
For Each ws In ThisWorkbook.Worksheets
With ActiveSheet
.Cells(1, 1) = "Inhaltsverzeichnis:"
.Cells(1, 1).Font.Size = 12
.Cells(i, 1) = i - 2
With .Columns("A:B")
.Interior.ColorIndex = 15
.Font.Name = "Arial"
.Font.Italic = False
.Font.Bold = False
End With
With Range("A1:B1")
.Font.Bold = True 'fett
.Interior.ColorIndex = 16
.Font.Color = vbWhite
End With
Columns(1).HorizontalAlignment = xlCenter 'mittig
Columns(2).HorizontalAlignment = xlLeft 'links
.Columns(1).NumberFormat = "0""."""
.Cells(i, 2) = ws.Name
'.Hyperlinks.Add Anchor:=Cells(i, 2), Address:="", SubAddress:=.Cells(i, 2).Value & "!A1", _
ScreenTip:="Hyperlink klicken", TextToDisplay:=.Cells(i, 2).Value
.Hyperlinks.Add Anchor:=Cells(i, 2), Address:="", SubAddress:=.Cells(i, 2).Value & "!A1", _
ScreenTip:="klick hier um ins Register [" & .Cells(i, 2).Value & "] zu gelangen", TextToDisplay:=.Cells(i, 2).Value
End With
i = i + 1
Next ws
With ActiveSheet
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
Set raBereich = .Range(.Cells(3, 2), .Cells(loLetzte, 2))
For Each raZelle In raBereich
If raZelle = .Name Then
.Range(.Cells(raZelle.Row, 1), .Cells(raZelle.Row, 2)).Font.Size = 12
.Range(.Cells(raZelle.Row, 1), .Cells(raZelle.Row, 2)).Font.Color = vbRed
Else
.Range(.Cells(raZelle.Row, 1), .Cells(raZelle.Row, 2)).Font.Size = 12
.Range(.Cells(raZelle.Row, 1), .Cells(raZelle.Row, 2)).Font.Color = vbBlack
End If
Next raZelle
.Columns(1).ColumnWidth = 5
.Columns(2).AutoFit
End With
Set raBereich = Nothing
Application.ScreenUpdating = True
End Sub
Ich habe mal gepostet, dass einige Hyperlinks bei mir falsch anspringen, sprich man gelangt zu einem anderen Tabellenblatt (bspw. klickt man auf Hyperlink von Tabellenblatt 6, gelangt aber zum Tabellenblatt 2).
Ein Grund ist wohl ein Leerzeichen in einigen meiner Tabellenblattnamen. Sorry, ich weiß, dass man das meiden sollte, aber kann man das Leerzeichen mit VBA-Code akzeptieren lassen?
Gruß
Martin