VBA | Double click | Range i.p.v. losse cell

[JordyWegman]

Beste,

Voor een onderzoek heb ik diverse criteria opgesteld waarvan elke criteria 3 statussen kan hebben, namelijk 0, 1 en 2. Ik heb een VBA code gemaakt die er voor zorgt dat ik door middel van een double-click 3 waardes kan krijgen. Eerst waarde 0, daarna waarde 1, daarna waarde 2 en als laatste waarde 0 weer. De opmaak heb ik gemaakt op zo'n manier dat 0 = Groen bord, 1 = Oranje bord en 2 = Rood bord.

Het probleem zit hem er in dat ik los elke cel moet bepalen in VBA. In de code kunnen jullie zien dat ik hem al 6 keer heb gekopieerd. Ik probeer een range aan te geven (bijvoorbeeld A10:CC500), maar dan werkt de macro niet meer. Zou iemand mij kunnen uitleggen hoe ik hier het laatste stuk Range in kan bouwen?

In de bijlage is het bestand te vinden.

Alvast bedankt!

Jordy

Bekijk bijlage double-click.xls

 

[Cobbe]

Zet dat in je werkblad waarin dit moet gebeuren:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, Range("A10:CC500")) Is Nothing Then Exit Sub

        Select Case ActiveCell.Value
        Case "0"
            ActiveCell.Value = "1"
        Case "1"
            ActiveCell.Value = "2"
        Case Else
            ActiveCell.Value = "0"
        End Select
    
End Sub

 

[jkpieterse]

Zo:

If Not Intersect(Selection.Address, Range("A10:CC500")) Is Nothing Then

Beter nog is het om het dubbelklikbereik een naam te geven (bijv "DubbelKlikBereik") en dan dit te gebruiken

If Not Intersect(Selection.Address, Range("DubbelKlikBereik")) Is Nothing Then

Dan hoef je alleen de definitie van DubbelKlikBereik aan te passen aan de voorkant en blijft je macro werken.

 

[JeanPaul28]

Je bestand iets aangepast, in cel C1 verschijnt de waarde

 

[E v R]

Bij het DoubleClick event zou ik de parameter Cancel ook gebruiken

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("DubbelKlikBereik")) Is Nothing Then
        With Target
        Select Case .Value
        Case "0"
            .Value = "1"
        Case "1"
            .Value = "2"
        Case Else
            .Value = "0"
        End Select
  Cancel = True
  End With
 End If
End Sub

 

[VenA]

Is het niet een beetje groot bereik dat je vol wil zetten dmv een dubbelklik?

De code kan wat eenvoudiger.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [A10:CC500]) Is Nothing Then Exit Sub
    If Target = 2 Then Target = 0 Else Target = Target + 1
Cancel = True
End Sub

 

[JordyWegman]

Heren,

Bedankt voor de snelle reacties. De code van Cobbe gaf nog een probleem. Hij veranderde inderdaad de waarde, maar gaf steeds een compileer fout. Ik heb de code van E v R gebruikt om hem compleet te maken en hij werkt! Ik weet zo niet hoe jullie die code netjes in de zo'n vak hebben geplaatst, maar hier onder staat hij nogmaals.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Intersect(Target, Range("A10:CC500")) Is Nothing Then Exit Sub

Select Case ActiveCell.Value
Case "0"
ActiveCell.Value = "1"
Case "1"
ActiveCell.Value = "2"
Case Else
ActiveCell.Value = "0"
End Select
Cancel = True
End Sub

In de bijlage heb ik heb Excel bestand toegevoegd voor de gene die dit nog willen zien.

Bedankt voor de hulp!

Bekijk bijlage double-click.xls