• 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.

Macro starten door klik op cel

Status
Niet open voor verdere reacties.

SUVERMO

Gebruiker
Lid geworden
22 dec 2019
Berichten
478
Goedenavond iedereen

In bijgevoegd bestand starten macro’s door een klik op een gekleurde cel en afhankelijk van de inhoud van deze cel. De macro’s die uitgevoerd worden na het klikken op een rode cel moeten nog gemaakt worden.
De macro’s die uitgevoerd moeten worden staan in Module1
In ieder blad staat onderstaande code. Kan dit anders, eenvoudiger en eventueel sneller?


Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    If Target.Address = "$AA$1:$AA$2" Then
    If Range("$AA$1").Value = "Opslaan als" Then
    Opslaan_als
    End If
    End If
    If Target.Address = "$AA$3:$AA$4" Then
    If Range("$AA$3").Value = "Opslaan" Then
    Opslaan
    End If
    End If
    If Target.Address = "$AA$11:$AA$12" Then
    If Range("$AA$11").Value = "Opslaan en sluiten" Then
    Opslaan_en_sluiten
    End If
    End If
    If Target.Address = "$AA$13:$AA$14" Then
    If Range("$AA$13").Value = "Sluiten zonder opslaan" Then
    Sluiten_zonder_opslaan
    End If
    End If
    If Target.Address = "$AA$15:$AA$16" Then
    If Range("$AA$15").Value = "Ga naar Dieren_Bib" Then
    Ga_naar_Dieren_Bib
    End If
    End If
    If Target.Address = "$AA$17:$AA$18" Then
    If Range("$AA$17").Value = "Ga naar Stamboom" Then
    Ga_naar_Stamboom
    End If
    End If
    If Target.Address = "$AA$19:$AA$20" Then
    If Range("$AA$19").Value = "Ga naar Nesten" Then
    Ga_naar_Nesten
    End If
    End If
    If Target.Address = "$AA$21:$AA$22" Then
    If Range("$AA$21").Value = "Ga naar Nakomelingen" Then
    Ga_naar_Nakomelingen
    End If
    End If
    If Target.Address = "$AA$23:$AA$24" Then
    If Range("$AA$23").Value = "Ga naar Verwanten" Then
    Ga_naar_Verwanten
    End If
    End If
    If Target.Address = "$AA$25:$AA$26" Then
    If Range("$AA$25").Value = "Ga naar Soorten" Then
    Ga_naar_Soorten
    End If
    End If
    If Target.Address = "$AA$27:$AA$28" Then
    If Range("$AA$27").Value = "Ga naar Rassen" Then
    Ga_naar_Rassen
    End If
    End If
    If Target.Address = "$AA$29:$AA$30" Then
    If Range("$AA$29").Value = "Ga naar Kleuren" Then
    Ga_naar_Kleuren
    End If
    End If
    If Target.Address = "$AA$31:$AA$32" Then
    If Range("$AA$31").Value = "Ga naar Informatie" Then
    Ga_naar_Informatie
    End If
    End If
    If Target.Address = "$AA$33:$AA$34" Then
    If Range("$AA$33").Value = "Opdracht 1" Then
    Opdracht_1
    End If
    End If
    If Target.Address = "$AA$35:$AA$36" Then
    If Range("$AA$35").Value = "Opdracht 2" Then
    Opdracht_2
    End If
    End If
    If Target.Address = "$AA$37:$AA$38" Then
    If Range("$AA$37").Value = "Opdracht 3" Then
    Opdracht_3
    End If
    End If
End Sub
 

Bijlagen

  • macro's uitvoeren.xlsm
    65,3 KB · Weergaven: 32
Zo:
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Select Case Target.Address(0, 0)
        Case "AA1:AA2": Opslaan_als
        Case "AA3:AA4": Opslaan
    End Select
End Sub
De rest kan je dan zelf wel verzinnen.
 
Laatst bewerkt:
Gebruik geen samengevoegde cellen. Als de code op elk werkblad moet werken dan zet je het in de module van ThisWorkbook en zo kan ik nog veel meer verzinnen over hoe je de code logisch kan opbouwen.

Code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  If Not Intersect(Target, Sh.Columns(27)) Is Nothing Then
    For Each Sh In Sheets
      Sh.Visible = Sh.Name = "Informatie"
    Next Sh
  End If
  If Target.Text <> "" Then
    x = Split(Target.Text)
    If Not IsError(Evaluate(x(UBound(x)) & "!A1")) Then Sheets(x(UBound(x))).Visible = True
  End If
End Sub
 
Laatst bewerkt:
Zo:
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Select Case Target.Address(0, 0)
        Case "AA1:AA2": Opslaan_als
        Case "AA3:AA4": Opslaan
    End Select
End Sub
De rest kan je dan zelf wel verzinnen.

hoe moet If Range("$AA$1").Value = "" daarin verwerkt worden
 
Dat heb ik weg gelaten omdat het overbodig is.
 
met If Range("$AA$1").Value = "" moet wel rekening gehouden worden want als de cel leeg is moet de macro niet uitgevoerd worden.
Zie maar eens naar bijgevoegd plaatje.
 

Bijlagen

  • macro's uitvoeren edmoor.xlsm
    59,4 KB · Weergaven: 27
  • Informatie AA37.jpg
    Informatie AA37.jpg
    84,8 KB · Weergaven: 33
Omdat je samengevoegde cellen gebruikt kan je dit doen:
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    [COLOR="#FF0000"]If Target.Item(1).Value = "" Then Exit Sub[/COLOR]
    Select Case Target.Address(0, 0)
        Case "AA1:AA2": Opslaan_als
        Case "AA3:AA4": Opslaan
        Case "AA11:AA12": Opslaan_en_sluiten
        Case "AA13:AA14": Sluiten_zonder_opslaan
        Case "AA15:AA16": Ga_naar_Dieren_Bib
        Case "AA17:AA18": Ga_naar_Stamboom
        Case "AA19:AA20": Ga_naar_Nesten
        Case "AA21:AA22": Ga_naar_Nakomelingen
        Case "AA23:AA24": Ga_naar_Verwanten
        Case "AA25:AA26": Ga_naar_Soorten
        Case "AA27:AA28": Ga_naar_Rassen
        Case "AA29:AA30": Ga_naar_Kleuren
        Case "AA31:AA32": Ga_naar_Informatie
        Case "AA33:AA34": Opdracht_1
        Case "AA35:AA36": Opdracht_2
        Case "AA37:AA38": Opdracht_3
    End Select
End Sub
 
Gebruik nooit samengevoegde cellen !!
 
Je kan het hele zaakje ook vervangen door dit:
Code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Item(1).Value = "" Then Exit Sub
    If Intersect(Target, Range("AA1:AA38")) Is Nothing Then Exit Sub
    Application.Run Replace(Target.Item(1).Value, " ", "_")
End Sub

In de ThisWorkbook dus, wat VenA ook al zei.
Dan hoef je niks achter de werkbladen te zetten.
Verder eens met snb.
 
Laatst bewerkt:
heel hard bedankt voor de prima service
Waarom nooit samengevoegde cellen gebruiken?
 
Omdat dat in VBA altijd problemen geeft, zoals die waar je nu tegenaan liep.
 
Het is een indicatie van onvoldoende kennis en begrip van Excel.
 
Een van de nadelen van de selection change is dat je die op een cel niet twee keer achter elkaar kunt uitvoeren, zie jouw functie Opslaan.
Kun je oplossen door direct een andere cel te activeren maar dat komt de gebruikers beleving niet ten goede.
Ik geef zelf meestal de voorkeur aan hyperlinks. Eventueel kun je die opvangen in het follow hyperlink event.

In de meeste werkbladen gebruik ik samengevoegde cellen. Dus "nooit" zou ik in een advies nooit gebruiken...
 
Samengevoegde cellen kan je prima gebruiken als het gaat om benadrukken van een stuk tekst.
Gebruik het echter niet voor cellen waar formules of VBA codes gebruik van moeten maken.
 
bedankt voor de info, ik heb ook even gekeken op het web, best is dat ik er in het vervolg rekening mee tracht te houden.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan