• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Dubbelklik / loopfunctie?

Status
Niet open voor verdere reacties.
M

Mosselman

Gebruiker
Lid geworden
5 aug 2007
Berichten
61
Wie kan mij helpen met een vervolg:
----------------------------------------------------
Zodra op cel A5 wordt dubbelgeklikt, dan dient het eerste gedeelte uitgevoerd te worden. Daarna moet de code stoppen en niet verder gaan met de tweede code die, zoals na controle blijkt, niet eens meer kijkt of er wordt geklikt in A6. De rest van de code wordt sowieso uitgevoerd en dat is niet de bedoeling.
Wanneer ik EXIT sub gebruik, dan wordt de VBA volledig gestopt; Dat is niet de bedoeling.

Wat wil ik?
----------------
- Zodra je op A5 klikt dan dient het eerste gedeelte van de code uitgevoerd te worden en verder niets.
- Zodra je op A6 klikt dan dient alleen het tweede gedeelte van de code uitgevoerd te worden en verder niets.
- Zodra je op A7 klikt dan dient alleen het tweede gedeelte van de code uitgevoerd te worden en verder niets.

enzovoort.

- Deze functie moet ten aller tijden blijven werken. (Loopfunctie ofzo?).

Alvast bedankt.




Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = Range("A5").Address Then _
Sheets("Totaal reparaties").Select
Sheets("Totaal reparaties").Range("C3").Value = "Ranking MM - Alexandrium"
For Each cell In Worksheets("Totaal reparaties").Range("A5:GZ50")
If cell.Value = ("MM - Alexandrium") Then
With cell.Interior
.ColorIndex = 6
End With
End If
Next


If Target.Address = Range("A6").Address Then _
Sheets("Klantenreparaties").Select
Sheets("Klantenreparaties").Range("C3").Value = "Ranking MM - Alexandrium"
For Each cell In Worksheets("Klantenreparaties").Range("A5:GZ50")
If cell.Value = ("MM - Alexandrium") Then
With cell.Interior
.ColorIndex = 6
End With
End If
Next

If Target.Address = Range("A7").Address Then _
Sheets("Voorraadreparaties").Select
Sheets("Voorraadreparaties").Range("C3").Value = "Ranking MM - Alexandrium"
For Each cell In Worksheets("Voorraadreparaties").Range("A5:GZ50")
If cell.Value = ("MM - Alexandrium") Then
With cell.Interior
.ColorIndex = 6
End With
End If
Next




End Sub
 
Mosselman,

Wat dacht je van 3 code's?
Heb je dit probleem niet denk ik.
 
Hoornvan zei:
Mosselman,

Wat dacht je van 3 code's?
Heb je dit probleem niet denk ik.
Klik om te vergroten...

Bedoel je dat ik 3 maal de code:

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

Kan gebruiken in dezelfde sheet?
 
Aangezien veel coderegels hetzelfde zijn, dacht ik aan zoiets:

Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sWs As String
    Select Case Target.Address
        Case Range("A5").Address
            sWs = "Totaal reparaties"
        Case Range("A6").Address
            sWs = "Klantenreparaties"
        Case Range("A7").Address
            sWs = "Voorraadreparaties"
    End Select
    If sWs <> "" Then
        Sheets(sWs).Range("C3").Value = "Ranking MM - Alexandrium"

        For Each cell In Worksheets(sWs).Range("A5:GZ50")
            If cell.Value = ("MM - Alexandrium") Then
                cell.Interior .ColorIndex = 6
            End If
        Next
    End If
End Sub

Met vriendelijke groet,


Roncancio
 
1x code voor A5
1x code voor A6
1x code voor A7

Je heb nu 3 stukjes elk voor een cel, dus dacht ik 3 macro's met elk 1 stukje hier van.
 
Mosselman zei:
Bedoel je dat ik 3 maal de code:

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

Kan gebruiken in dezelfde sheet?
Klik om te vergroten...

Nee, dat kan niet omdat VBA dan niet weet welke gebruikt moet worden.
Er kan altijd maar 1 Worksheet_BeforeDoubleClick, Worksheet_Change, etc in een werkblad zitten.

Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Aangezien veel coderegels hetzelfde zijn, dacht ik aan zoiets:

Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sWs As String
    Select Case Target.Address
        Case Range("A5").Address
            sWs = "Totaal reparaties"
        Case Range("A6").Address
            sWs = "Klantenreparaties"
        Case Range("A7").Address
            sWs = "Voorraadreparaties"
    End Select
    If sWs <> "" Then
        Sheets(sWs).Range("C3").Value = "Ranking MM - Alexandrium"

        For Each cell In Worksheets(sWs).Range("A5:GZ50")
            If cell.Value = ("MM - Alexandrium") Then
                cell.Interior .ColorIndex = 6
            End If
        Next
    End If
End Sub

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

Bij deze code krijg ik een foutmelding bij .Colorindex.
Compileerfout: Ongeldige of niet-gekwalificeerde verwijzing.
Moet ik nog iets anders doen om deze code werkend te krijgen?
 
Bij deze code krijg ik een foutmelding bij .Colorindex.
Klik om te vergroten...
Er staat een spatie voor de punt, haal die weg.
Hier horen " bij te staan.
Code: 
Sheets(sWs)
Sheets([COLOR="red"]"[/COLOR]sWs[COLOR="Red"]"[/COLOR])
 
Laatst bewerkt:
Hoornvan zei:
Hier horen " bij te staan.
Code: 
Sheets(sWs)
Sheets([COLOR="red"]"[/COLOR]sWs[COLOR="Red"]"[/COLOR])
Klik om te vergroten...

Dit klopt niet omdat met de aanhalingstekens wordt uitgegaan van het werkblad sWs dat niet bestaat.
sWs is afhankelijk van de keuze die gemaakt wordt.

sWs kan dus Voorraadreparaties, Klantenreparaties of Totale reparaties zijn.

Met vriendelijke groet,


Roncancio
 
Roncancio,

Dit klopt niet omdat met de aanhalingstekens wordt uitgegaan van het werkblad sWs dat niet bestaat.
sWs is afhankelijk van de keuze die gemaakt wordt.
Klik om te vergroten...

Sorry foutje van mij.
Hij stopte bij mij hier, heb de bladnamen gemaakt en de " weggehaald en de macro loop nu wel door.
 
Hoornvan zei:
Sorry foutje van mij.
Hij stopte bij mij hier, heb de bladnamen gemaakt en de " weggehaald en de macro loop nu wel door.
Klik om te vergroten...

Ok, bedankt, ik ga verder experimenteren.

Heb je toevallig nog een tip om deze code te verkorten?

If Range("C3") = "Ranking MM - Alexandrium" Then
Range("C3").Value = ""
Range("B5:D36").Cells.Interior.ColorIndex = 15
Range("F5:H36").Cells.Interior.ColorIndex = 15
Range("J5:L36").Cells.Interior.ColorIndex = 15
Range("N5:P36").Cells.Interior.ColorIndex = 15
Range("R5:T36").Cells.Interior.ColorIndex = 15
Range("V5:X36").Cells.Interior.ColorIndex = 15
Range("Z5:AB36").Cells.Interior.ColorIndex = 15
Range("AD5:AF36").Cells.Interior.ColorIndex = 15
Range("AH5:AJ36").Cells.Interior.ColorIndex = 15
Range("AL5:AN36").Cells.Interior.ColorIndex = 15
Range("AP5:AR36").Cells.Interior.ColorIndex = 15
Range("AT5:AV36").Cells.Interior.ColorIndex = 15
Range("AX5:AZ36").Cells.Interior.ColorIndex = 15
Range("BB5:BD36").Cells.Interior.ColorIndex = 15
Range("BF5:BH36").Cells.Interior.ColorIndex = 15
Range("BJ5:BL36").Cells.Interior.ColorIndex = 15
Range("BN5:BP36").Cells.Interior.ColorIndex = 15
Range("BR5:BT36").Cells.Interior.ColorIndex = 15
Range("BV5:BX36").Cells.Interior.ColorIndex = 15
Range("BZ5:CB36").Cells.Interior.ColorIndex = 15
Range("CD5:CF36").Cells.Interior.ColorIndex = 15
Range("CH5:CJ36").Cells.Interior.ColorIndex = 15
Range("CL5:CN36").Cells.Interior.ColorIndex = 15
Range("CP5:CR36").Cells.Interior.ColorIndex = 15
Range("CT5:CV36").Cells.Interior.ColorIndex = 15
Range("CX5:CZ36").Cells.Interior.ColorIndex = 15
Range("DB5:DD36").Cells.Interior.ColorIndex = 15
Range("DF5:DH36").Cells.Interior.ColorIndex = 15
Range("DJ5:DL36").Cells.Interior.ColorIndex = 15
Range("DN5:DP36").Cells.Interior.ColorIndex = 15
Range("DR5:DT36").Cells.Interior.ColorIndex = 15
Range("DV5:DX36").Cells.Interior.ColorIndex = 15
Range("DZ5:EB36").Cells.Interior.ColorIndex = 15
Range("ED5:EF36").Cells.Interior.ColorIndex = 15
Range("EH5:EJ36").Cells.Interior.ColorIndex = 15
Range("EL5:EN36").Cells.Interior.ColorIndex = 15
Range("EP5:ER36").Cells.Interior.ColorIndex = 15
Range("ET5:EV36").Cells.Interior.ColorIndex = 15
Range("EX5:EZ36").Cells.Interior.ColorIndex = 15
Range("FB5:FD36").Cells.Interior.ColorIndex = 15
Range("FF5:FH36").Cells.Interior.ColorIndex = 15
Range("FJ5:FL36").Cells.Interior.ColorIndex = 15
Range("FN5:FP36").Cells.Interior.ColorIndex = 15
Range("FR5:FT36").Cells.Interior.ColorIndex = 15
Range("FV5:FX36").Cells.Interior.ColorIndex = 15
Range("FZ5:GB36").Cells.Interior.ColorIndex = 15
Range("GD5:GF36").Cells.Interior.ColorIndex = 15
Range("GH5:GJ36").Cells.Interior.ColorIndex = 15
Range("GL5:GN36").Cells.Interior.ColorIndex = 15
Range("GP5:GR36").Cells.Interior.ColorIndex = 15
Range("GT5:GV36").Cells.Interior.ColorIndex = 15
Range("GX5:GZ36").Cells.Interior.ColorIndex = 15
Sheets("Alexandrium").Select
Exit Sub
End If
 
Zoiets:

Code: 
Dim lKol As Long
If Range("C3") = "Ranking MM - Alexandrium" Then
    Range("C3").Value = ""
    For lKol = 2 To Range("GX1").Column Step 4
        Range(Cells(5, lKol), Cells(36, lKol + 2)).Interior.ColorIndex = 15
    Next
End If

Met vriendelijke groet,


Roncancio
 
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If not intersect(Target, [A5:A7]) is Nothing Then
    With Sheets(choose(target.row-4,"Totaal reparaties","Klantenreparaties","Voorraadreparaties")) 
      .[C3] = "Ranking MM - Alexandrium"
      For Each cl In .[A5:GZ50]
        If cl = "MM - Alexandrium" Then cl.Interior.ColorIndex = 6
      Next
    End with
  End If
End Sub
en

Code: 
If [C3] = "Ranking MM - Alexandrium" Then
    [C3].clearcontents
    For j=0 To [GX1].Column Step 4
        [B5:B36].offset(,j).Interior.ColorIndex = 15
    Next
End If
 
Laatst bewerkt:
Als je je code getest heeft, dan kon je zien dat beiden niet het gewenste resultaat geven.

Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If not intersect(Target, [A5:A7]) =Nothing Then
    With Sheets(choose(target.row-4,"Totaal reparaties","Klantenreparaties","Voorraadreparaties")) 
      .[C3] = "Ranking MM - Alexandrium"
      For Each cl In .[A5:GZ50]
        If cl = "MM - Alexandrium" Then cl.Interior.ColorIndex = 6
      Next
    End with
  End If
[COLOR="Red"]Next[/COLOR]
Dit moet End Sub zijn. Er staat immers geen For meer in de code.

en

Code: 
If [C3] = "Ranking MM - Alexandrium" Then
    [C3].clearcontents
    For j=0 To [GX1].Column Step 4
        [B5:[COLOR="Red"]B[/COLOR]36].offset(,j).Interior.ColorIndex = 15
    Next
End If

Dit moet D zijn.
Het gaat namelijk om 3 kolommen ipv 1.

Met vriendelijke groet,


Roncancio
 
Goed gezien !
Dank voor je aanvullingen.
 
Laatst bewerkt:
Roncancio zei:
Als je je code getest heeft, dan kon je zien dat beiden niet het gewenste resultaat geven.

Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If not intersect(Target, [A5:A7]) =Nothing Then
    With Sheets(choose(target.row-4,"Totaal reparaties","Klantenreparaties","Voorraadreparaties")) 
      .[C3] = "Ranking MM - Alexandrium"
      For Each cl In .[A5:GZ50]
        If cl = "MM - Alexandrium" Then cl.Interior.ColorIndex = 6
      Next
    End with
  End If
[COLOR="Red"]Next[/COLOR]
Dit moet End Sub zijn. Er staat immers geen For meer in de code.

en

Code: 
If [C3] = "Ranking MM - Alexandrium" Then
    [C3].clearcontents
    For j=0 To [GX1].Column Step 4
        [B5:[COLOR="Red"]B[/COLOR]36].offset(,j).Interior.ColorIndex = 15
    Next
End If

Dit moet D zijn.
Het gaat namelijk om 3 kolommen ipv 1.

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

Super al die VBA-lessen.
Nu heb ik nog het probleem dat hij bij NOTHING aangeeft "Compileerfout".
Is dat ook nog op te lossen?
 
= Nothing moet zijn Is Nothing
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan