Geheugen vraag

[LucB]

Hallo Excellers,

In onderstaande code kunt u hopelijk zien waar ik mee bezig ben.
Tot nu toe gedaan:
6 cellen afgedekt met een rechthoek.(A1:C2)
Klikken op een cel maakt de inhoud zichtbaar.

Doel is:
Na 2x een klik op een willekeurige rechthoek moet het absolute verschil tussen de dan 2 zichtbare cellen 10 zijn.
Is dat niet het geval dan moet de 2 zichtbare cellen weer bedekt worden door hun bijbehorende rechthoek.

Graag Uw hulp om dit te verwezelijken.

Sub test()
    Dim MyCell As Range
    Dim n      As Long
    Dim p      As Long
    
    'In A1 is Rectangle 1, in B1 is Rectangle 2, in C1 is Rectangle 3.
    'In A2 is Rectangle 4, in B2 is Rectangle 5, in C2 is Rectangle 6.
    'de Rectangles en de cellen zijn 88x88 pixels en hebben de Macro's Rec1 t/m Rec6
    
    For n = 1 To 6
        ActiveSheet.Shapes("Rectangle " & n).Select
        Selection.ShapeRange.Fill.Visible = msoTrue
    Next n
    
    'In E5:E10  =ASELECT()
    'In F5:F10   A1,B1,C1,A2,B2,C2
    'In G5:G10   10,20,30,40,50,60.
    
    Range("E5:F10").Sort Key1:=Range("E5"), Order1:=xlAscending, Header:=xlGuess, _
                         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

    For p = 1 To 6
        Set MyCell = ActiveSheet.Range(Range("F" & p + 4))
        MyCell.Value = Range("F" & p + 4).Offset(0, 1).Value
    Next p

    Set MyCell = Nothing
    Range("D1").Select
End Sub

Sub Rec1()
    ActiveSheet.Shapes("Rectangle 1").Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    Range("A1").Select
    
End Sub
Sub Rec2()
    ActiveSheet.Shapes("Rectangle 2").Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    Range("B1").Select
End Sub
Sub Rec3()
   ActiveSheet.Shapes("Rectangle 3").Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    Range("C1").Select
End Sub
Sub Rec4()
    ActiveSheet.Shapes("Rectangle 4").Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    Range("A2").Select
End Sub
Sub Rec5()
   ActiveSheet.Shapes("Rectangle 5").Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    Range("B2").Select
End Sub
Sub Rec6()
    ActiveSheet.Shapes("Rectangle 6").Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    Range("C2").Select
End Sub

Met vr. groet,
Luc

 

[LucB]

Hallo Erik,

Gij zijt vasthoudend, maar geloof me,ik kan er best mee leven.

Het zou me een grote eer zijn als ik je het resultaat zou mogen toesturen.
Ik heb er onderhand 2 programma's van gemaakt.

Wat vind er van?

Gret,
Luc

 

[erik.van.geit]

ja, da's een mooi voorstel
af en toe komen hier wat "beloningen" toegestroomd na een lange "werkdag" op MrExcel
just click the emailbutton onder mijn posts

thanks
Gods Zegen !
Erik

 

[erik.van.geit]

Luc,
hartelijk thank you om de file te zenden

Private Sub Worksheet_Activate()
ActiveSheet.Protect Password:="123", Scenarios:=True, DrawingObjects:=True
Worksheets(1).ScrollArea = "L1"
End Sub

de vette lijn geeft problemen, gebruiker kan niet meer terug naar A1 om te spelen
misschien dat je niet wil dat ze kunnen "spieken" achter de rechthoeken ?
zet gewoon de celeigenschappen op "verborgen"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Me.Saved = True

wat is hiermee je bedoeling ? als ze niet mogen saven heb je nog meer nodig, maar misschien doe je dit enkel om dat opslaan toch niet belangrijk is ?

beste goreten,
Erik

 

[LucB]

Erik,
Bedankt voor de gegeven aandacht.
Neem je advies graagter harte.

En ook van mij
de beste goreten
Luc

 

[erik.van.geit]

garag gedana