AW: ausgeblendete Blätter
04.11.2014 10:16:55
fcs
Hallo Michael,
man kann die ausgeblendeten Blätter temporär zu Beginn des Makros einblenden und am Ende wieder ausblenden. Die erzeugten Hyperlinks zur Nachfolger-Zelle funktionieren aber nur wenn die entsprechenden Blätter eingeblendet sind.
Gruß
Franz
Sub ShowDependents()
'Die Prozedur prüft ob die aktive Zelle (oder die erste
'eines markierten Bereiches) Nachfolge-Zellen hat,
'Werden solche gefunden wird die Zelle eingefärbt und die
'Adressen der Nachfolger werden im Kommentar der Zelle eingetragen.
Dim DependentCellArray() As String
Dim rngFirstCell As Range
Dim rngSelected As Range
Dim rngCell As Range
Dim arrHidden() As Worksheet, arrStatus() As Long, intHidden As Integer, wks As Worksheet
'ausgeblendete Blätter in einem Array merken und einblenden
For Each wks In ActiveWorkbook.Worksheets
If wks.Visible xlSheetVisible Then
intHidden = intHidden + 1
ReDim Preserve arrHidden(1 To intHidden)
ReDim Preserve arrStatus(1 To intHidden)
Set arrHidden(intHidden) = wks
arrStatus(intHidden) = wks.Visible
wks.Visible = xlSheetVisible
End If
Next
If TypeName(Selection) = "Range" Then
Set rngFirstCell = ActiveCell
Set rngSelected = Selection
For Each rngCell In Selection
rngSelected.Select
rngCell.Activate
Application.ScreenUpdating = True
If GetDirectDependentsArray(ActiveCell, DependentCellArray) Then
With rngCell
.ClearComments
.AddComment "wird verwendet:" & Chr(10) & _
Join(DependentCellArray, Chr(10))
.Interior.ColorIndex = 35
.Comment.Visible = False
End With
ActiveSheet.Hyperlinks.Add rngCell, "#" & DependentCellArray(0)
Else
With rngCell
.ClearComments
.Interior.ColorIndex = xlNone
.Hyperlinks.Delete
End With
End If
Next
rngSelected.Select
rngFirstCell.Activate
End If
'Blätter ggf. wieder ausblenden
If intHidden > 0 Then
For intHidden = 1 To UBound(arrHidden)
arrHidden(intHidden).Visible = arrStatus(intHidden)
Next
Erase arrHidden, arrStatus
End If
End Sub