Tekst doorhalen na dubbelklikken op cel

[adile]

Goedenavond,

Ik heb een bestandje met in een werkmap de volgende VBA code.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Union(Range("H12:Q21"), Range("AX2:AX4"))) Is Nothing Then
 Target.Value = Time
   If Target.Column = 8 Then Target.Offset(, 12) = Target.Offset(, 12).Value
End If
Cancel = True

End Sub

Ik wil in deze code toevoegen dat bij dubbelklikken op de cellen AS27t/m AS999, de tekst die in de betreffende cel staat wordt doorgehaalt.
ik heb dit stukje kunnen vinden, maar hoe voeg ik deze toe aan de bovenstaande code?

'Strikethroughtext Macro

Range ("AS27:AS999")

Selection.Font.Strikethrough = True

End Sub

Kan iemand mij hierbij helpen,
Alvast bedankt


MVG adile

 

[gast0660]

Hoi,
Probeer deze

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Union(Range("H12:Q21"), Range("AX2:AX4"))) Is Nothing Then
 Target.Value = Time
   If Target.Column = 8 Then Target.Offset(, 12) = Target.Offset(, 12).Value
End If
[COLOR="#FF0000"]If Target.Column = 45 And (Target.Row >= 26 And Target.Row <= 1000) Then
Target.Select
Selection.Font.Strikethrough = True
  End If[/COLOR]
Cancel = True

End Sub

 

[edmoor]

Waarbij je uiteraard de .Select niet zou moeten gebruiken:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Union(Range("H12:Q21"), Range("AX2:AX4"))) Is Nothing Then
        Target.Value = Time
        If Target.Column = 8 Then Target.Offset(, 12) = Target.Offset(, 12).Value
    End If
    If Target.Column = 45 And (Target.Row >= 26 And Target.Row <= 1000) Then
        Target.Font.Strikethrough = True
    End If
    Cancel = True
End Sub

 

[adile]

goedemiddag dotchie en edmoor,

hartelijk dank voor de oplossing, de code doet zijn werk.:thumb:
alleen wanneer ik nu bv een tekst heb staan op AS24 en ik dubbelklik op de cel dan wordt deze netjes doorgestreept.
Wanneer ik de doorgestreepte tekst verwijder en ik wil een nieuwe tekst in de cel tikken wordt deze automatisch doorgestreept.
is er een mogelijkheid dat bij het deleten van de tekst de cel weer normaal wordt?

tevens een aanvullende vraag op deze code,
ik wil het tijdstip van het doorhalen van de tekst vastleggen imet dit stukje

Target.Offset(0, 4) = Format(Now(), "HH:MM")

waar plaats ik deze tekst?

Adile

 

[Timshel]

Het is een beetje droogzwemmen zonder voorbeeldje.
Vraag1:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 45 Then Target.Font.Strikethrough = False
End Sub

Vraag2:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Union(Range("H12:Q21"), Range("AX2:AX4"))) Is Nothing Then
        Target.Value = Time
        If Target.Column = 8 Then Target.Offset(, 12) = Target.Offset(, 12).Value
    End If
    If Target.Column = 45 And (Target.Row >= 26 And Target.Row <= 1000) Then
        Target.Offset(0, 4) = Format(Now(), "HH:MM")
        Target.Font.Strikethrough = True
    End If
    Cancel = True
End Sub

 

[adile]

Timshel,

Ondanks het droogzwemmen is het toch gelukt
Hij werkt helemaal zoals het moet.
dank je voor je hulp :thumb:

Adile