AW: Hyperlink
12.02.2015 12:34:13
Beverly
Hi Willi,
man muss nur noch eine weitere Case-Anweisung hinzufügen für Spalte 18:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim strPfad As String
If Target.Row > 3 And Target.Cells.Count = 1 Then
Application.EnableEvents = False
Select Case Target.Column
Case 12
With Range(Cells(Target.Row, 1), Cells(Target.Row, 12)).Interior
If LCase(Target.Value) = "x" Then
.ColorIndex = 36
.Pattern = xlSolid
Else
.ColorIndex = xlColorIndexNone
.Pattern = xlSolid
End If
End With
Case 13
With Range(Cells(Target.Row, 1), Cells(Target.Row, 13)).Interior
If LCase(Target.Value) = "x" Then
.ColorIndex = 4
.Pattern = xlSolid
Target.Offset(0, 1).Value = Date
Target.Offset(0, -1).ClearContents
Target.Offset(0, 2).Value = Target.Offset(0, -4).Value
Else
.ColorIndex = xlColorIndexNone
.Pattern = xlSolid
Target.Offset(0, 1).ClearContents
Target.Offset(0, 2).ClearContents
End If
End With
Case 18
strPfad = "F:\Datei\Rechnungsordner\"
If Target.Count = 1 And Target "" Then
If Dir(strPfad & Target.Value & ".docx") "" Then
ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:=strPfad & _
Target.Value & ".docx", TextToDisplay:=Target.Value
End If
End If
End Select
Application.EnableEvents = True
End If
End Sub