Kommentar automatisch anzeigen lassen

[DietmarD]

Hallo zusammen,

ich habe eine Tabelle 2(Material) dort steht in Spalte C ab Zeile 2 eine Materialnummer, in Spalte D steht der dazugehörige Materialtext.
In Tabelle 1(Gestelllager) trage ich in beliebigen Zellen über eine Formel die Materialnummer ein, die auch mehrfach vorkommen kann. 

Meine Frage hierzu, ist es möglich, wenn ich mit der Maus auf meine Materialnummer in Tabelle 1(Gestelllager) auch ohne klick gehe, das mir dann der passende Materialtest angezeigt wird z.B. so wie ein Kommentar?  

Ich hoffe das ich mich hier verständlich ausgedrückt habe.

[schauan]

Hallöchen,

prinzipiell könnte so was funktionieren. Allerdings müsstest Du ständig ein Makro laufen lassen, welches die Mausposition auswertet, die darunter liegende Zelle prüft und je nach Lage und Inhalt etwas anzeigt.
Vielleicht wäre es besser, mit Kommentaren zu arbeiten und diese ggf. einfach per Button zu aktualisieren oder z.B. nach einer Zelleingabe.

[DietmarD]

Hallo Andre,

vielen Dank für deine Antwort.

Ich würde mich auch über eine Lösung mit Klick oder nicht unbedingt mit Kommentarfeld sonder evtl. eine Userform freuen, wenn das gehen sollte.

Wenn nicht, dann muss ich das Projekt wohl zu den Akten legen.

[MisterBurns]

Hallo,

eine schnelle und einfache Lösung wäre dieser Code, den du in das Modul des Tabellenblatts "Gestelllager" einträgst.

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Fund As Range
If Target.Count = 1 Then
    If Target.Value <> "" Then
        Set Fund = Worksheets("Material").Columns(3).Find(Target.Value)
        If Not Fund Is Nothing Then
            Range("A1") = Worksheets("Material").Cells(Fund.Row, 4)
        Else
            Range("A1").ClearContents
        End If
    Else
        Range("A1").ClearContents
    End If
Else
    Range("A1").ClearContents
End If
End Sub

Damit wird dir der jeweilige Materialtext Zelle A1 angezeigt, sofern vorhanden und nur eine Zelle ausgewählt ist.
Dafür musst du aber den Zellenverbund in A1 aufheben, das ist sowieso eine Unart.

[DietmarD]

Hallo Berni,

vielen Dank für deine Lösung.

Damit kann ich in jedem Fall leben.  :15:

[Kuwer]

Hallo Dietmar,

hier mal noch "zusätzlich" mit Rechtsklick:

Code:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  Dim varTemp As Variant
  If Target.Row > 1 Then
    If Target.Offset(-1).Value = "M" Then
      Cancel = True
      With Application.CommandBars.Add("CBar_Material", msoBarPopup, , True)
        With .Controls.Add(msoControlButton, , , , True)
          varTemp = Split(Mid(Target.Formula, 2), "!")
          .Caption = Worksheets(varTemp(0)).Range(varTemp(1)).Offset(, 1).Value
        End With
        .ShowPopup
        .Delete
      End With
    End If
  End If
End Sub

Gruß Uwe

[DietmarD]

Hallo Uwe,
deine Lösung ist ja schon in etwa so wie ich mir das mit dem Kommentar vorgestellt habe.

Das Problem was auftritt ist, wenn ich in eine leere Zelle mit rechts klicke, dann bekomme ich einen Debuggen der auch nach schließen und der Betätigung mit ja bestehen bleibt, ich muss dann die Datei neu öffnen.
Gibt es dafür noch eine Lösung?
Danke!

[MisterBurns]

@Uwe: Feine Lösung, das kannte ich noch gar nicht! Sehr elegant! :100:

[Kuwer]

Hallo Dietmar,

Code:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  Dim varTemp As Variant
  If Target.Row > 1 Then
    If Target.Offset(-1).Value = "M" Then
      Cancel = True
      On Error Resume Next
      Application.CommandBars("CBar_Material").Delete
      On Error GoTo 0
      With Application.CommandBars.Add("CBar_Material", msoBarPopup, , True)
        With .Controls.Add(msoControlButton, , , , True)
          varTemp = Split(Mid(Target.Formula, 2), "!")
          If UBound(varTemp) = 1 Then
            .Caption = Worksheets(varTemp(0)).Range(varTemp(1)).Offset(, 1).Value
          End If
        End With
        .ShowPopup
        .Delete
      End With
    End If
  End If
End Sub

Gruß Uwe

[DietmarD]

Hallo Uwe,

vielen Dank für die schnelle Hilfe.

Perfekt funktioniert. :18:

@Berni auch dir einen herzlichen Dank.