Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error GoTo Fehler
Dim Pfad As String, m2Name As String, Pos As Long
Pfad = "D:\Daten\Entwicklung\Tests\Rohstoffverzeichnis.xlsx"
If Not Intersect(Target, Columns(3)) Is Nothing Then
If IsEmpty(Target) Then Exit Sub Else Cancel = True
If Pfad <> "" Then m2Name = Right(Pfad, Len(Pfad) - InStrRev(Pfad, "\"))
If Not IsOpen(m2Name) Then Workbooks.Open Pfad
With Workbooks(m2Name).Worksheets(1)
Pos = Application.Match(Target.Value, .Columns(1), 0)
.Activate
If Pos > 0 Then
.Cells(Pos, 15).Select
.Cells(Pos, 15).Hyperlinks(1).Follow
End If
End With
End If
Exit Sub
Fehler:
MsgBox "Artikel " & Target & " nicht in Datei " & m2Name & " gefunden."
End Sub
Private Function IsOpen(wbName As String) As Boolean
On Error Resume Next
IsOpen = Workbooks(wbName).Name <> ""
End Function