Microsoft Excel

Herbers Excel/VBA-Archiv

ausgeblendete Blätter

Betrifft: ausgeblendete Blätter von: Michael
Geschrieben am: 04.11.2014 09:07:35

Guten Morgen Zusammen,

aus dem Internet habe ich ein Makro geladen, dass folgende Aufgabe erfüllt:
Für eine markierte Zelle [oder Bereich] werden die Nachfolger als Kommentar hinterlegt. Außerdem werden Hyperlinks zu den Nachfolger erzeugt.

Hier die Datei: https://www.herber.de/bbs/user/93531.xlsm

Leider funktioniert das Ganze nicht, wenn die Blätter, auf denen sich der Nachfolger befindet, ausgeblendet sind.

Leider verstehe ich zu wenig von VBA, um das Makro entsprechend zu ändern.

Wer kann mir helfen??

Gruß

Michael

  

Betrifft: AW: ausgeblendete Blätter von: fcs
Geschrieben am: 04.11.2014 10:16:55

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



  

Betrifft: hatte was vergessen :-)) von: Michael
Geschrieben am: 04.11.2014 10:41:12

Hallo Franz,

leider klappt Deine gute Idee nicht ganz: Ich habe die Mitteilung vergessen, dass bestimmte Blätter beim verlassen automatisch (über ein Ereignismakro) ausgeblendet werden.

Entschuldige vielmals!

Ist das trotzdem zu lösen?

Gruß

Michael


  

Betrifft: AW: hatte was vergessen :-)) von: fcs
Geschrieben am: 04.11.2014 11:03:33

Hallo Michael,

probier es mal mit zusätzlich vorübergehender Deaktivierung der Ereignismakros.

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
Application.EnableEvents = False
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
Application.EnableEvents = True
End Sub



  

Betrifft: Danke! Funktioniert super! von: Michael
Geschrieben am: 04.11.2014 11:34:07




 

Beiträge aus den Excel-Beispielen zum Thema "ausgeblendete Blätter"