dubbelklikken bij range cellen

[bjornesto]

Beste ik heb hieronder een code in mijn excel file staan.

1 Nu als ik op een andere cel dubbelklik in die file bv D17 en andere cellen die niet bij de range hieronder staan, dan geeft hij een run-time error '13' type mismatch en hij zou die foutmelding niet meer mogen geven

2 Graag zou ik ook volgende cellen erbij C42:C45, B134:B161, C134,B161 in die code willen zetten maar heb die samen gevoegd dus dat zou ook moeten erin gezet worden als je erop dubbelklikt dat automatisch het uur erin komt te staan

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Value = Empty And Target.Count = 1 And Not Intersect(Target, Range("C36:C40, C46, C48:C69, G48:G69, C71:C111,B113:C133,B162:C164, B195, C226:C233,C235:C244")) Is Nothing Then Target.Value = Format(Now(), "hh:mm")
End Sub

is dit mogelijk

 

[HSV]

Test het eens.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If IsEmpty(Target) And Target.Count = 1 Then
  If Not Intersect(Target, Range("C36:C40, C46, C48:C69, G48:G69, C71:C111,B113:C133,B162:C164, B195, C226:C233,C235:C244")) Is Nothing Then Target.Value = Format(Now(), "hh:mm")
    Else
 Select Case Target.Address
   Case "$C$42:$C$45", "$B$134:$B$161", "$C$134:$C$161"
     Target.Value = Format(Now(), "hh:mm")
   End Select
 End If
End Sub

 

[Warme bakkertje]

Als je het storend vindt dat de cursor in de aangeklikte cel blijft 'hangen' plaats dan onderstaande regel bovenaan de macro.

Cancel = True

 

[bjornesto]

Beste

Code werkt perfect.

Echter die Cancel = True werkt niet maar moet niet echt toch bedankt om de code aan te passen

 

[HSV]

Cancel = True werkt perfect hoor, beste.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
[COLOR=#ff0000]Cancel = True
[/COLOR]If IsEmpty(Target) And Target.Count = 1 Then
  If Not Intersect(Target, Range("C36:C40, C46, C48:C69, G48:G69, C71:C111,B113:C133,B162:C164, B195, C226:C233,C235:C244")) Is Nothing Then Target.Value = Format(Now(), "hh:mm")
    Else
 Select Case Target.Address
   Case "$C$42:$C$45", "$B$134:$B$161", "$C$134:$C$161"
     Target.Value = Format(Now(), "hh:mm")
   End Select
 End If
End Sub