Trafiklys i VBA

Hvor havde du tænkt dig, at "Trafiklyset" skulle være placeret?

Lige nu er det lige gyldigt. Det skal gerne være placeret i samme ark - tilfældigt.

På sigt, vil jeg gerne kunne flytte trafilysene, men fremgår det ikke af koden, hvorfra de skal hente data?

Håber meget du kan hjælpe

Koden indsættes i Ark1
Hvis du sender en mail til: pb@supertekst-it.dk - så sender jeg "TrafikLysfilerne", som er hentet fra Wikipidia - skal nok finpudses lidt m.h.t. størrelsen.
===========================================================================

Rem Celler til test af "lys"
Const cell1 = "A1"
Const cell2 = "A2"

Rem Placering - kan ændres efter ønske
Const fraVenstre = 265.5
Const fraTop = 4#

Dim sti
Private Sub worksheet_activate()
    sti = findSti
   
Rem evt. gl. lys slettes
    fjernTrafikLys
   
Rem hvis testceller er udfyldt - tændes lys
    If Range(cell1) <> "" And Range(cell2) <> "" Then
        tændTrafikLys
    End If
End Sub
Private Function findSti()
    findSti = ActiveWorkbook.Path
    If Right(findSti, 1) <> "\" Then
        findSti = findSti + "\"
    End If
End Function
Private Sub tændTrafikLys()
Dim lys
   
    If Range(cell1).Value > Range(cell2).Value Then
        lys = "grøn"
    Else
        If Range(cell1) = Range(cell2) Then
            lys = "gul"
        Else
            lys = "rød"
        End If
    End If
   
Rem cellen anvendes som udgangspunkt for justering
    Cells(1, 1).Activate
    ActiveSheet.Pictures.Insert(sti + lys + ".bmp").Select
    Selection.ShapeRange.IncrementLeft fraVenstre
    Selection.ShapeRange.IncrementTop fraTop
    Cells(1, 1).Activate
   
End Sub
Private Sub fjernTrafikLys()
    For Each lys In ActiveSheet.Pictures
        lys.Delete
    Next
End Sub
Rem Hvis TestCeller ændres beregnes "nyt trafiklys"
Rem ===============================================
Private Sub worksheet_Change(ByVal Target As Excel.Range)
Dim ræk, kol
    ræk = Target.Row
    kol = Target.Column
   
    If ræk = 1 Or ræk = 2 And kol = 1 Then
        worksheet_activate
    End If
End Sub

Send et svar - så er der point. Tusind tak for hjælpen.

Det får du så - & selv tak