formatering as celle efter løkke

Sub Find_Matches()

          Dim CompareRange As Variant, y As Variant, A As Long
        Set CompareRange = Range("f5:f9")
        A = Application.WorksheetFunction.Max(CompareRange)
     
              For Each y In CompareRange
                  If y = A Then
                  Range(y.Address).Font.Size = 20
                  ' mere kode
                  Exit Sub
                End If
              Next y

      End Sub

At gøre teksten større, farve den, baggrundsfarve i ecllen mm. kan gøres via betinget formatering - altså helt uden kode.

Marker dit område og vælg Betinget formatering. Sæt første rude til Formlen er, og indsæt denen formel: =F5=MAKS($F$5:$F$9))

Vælg derefter den øsnkede formatering.

Begge forslag er helt sikket brugbare........men hvis jeg også ønsker at få den til at vise et billede alt efter hvilken celle der er størts? Det er en række personer og cellerne dækker over hvor meget de har lavet. Den der så er bedst skal selvfølgelig ha sit navn op på skærmen.

1. Højreklik på øverste menulinie
    sæt flueben i kontrolelementer
2.

find iconknappen til billeder, det er den nederste,
tryk den ind og tegn en firkant på arket hvor billedet skal være

3.

lav et bibliotek med billeder af de ansatte, i f.eks .Jpg format

Det du kalder billederne skal stå ved siden af tallene i E kolonnen, uden endelsen .Jpg

4.

her nede i koden retter du C:\Ansatte\ til din sti

sæt så koden ind i Arkmodulet, så skulle den køre når du klikker på billedet

5.

med tekststørrelsen gør du som jkrons foreslår, det er det nemmeste.


Private Sub Image1_Click()
  Dim CompareRange As Variant, y As Variant, A As Long, Billede As String
        Set CompareRange = Range("f5:f9")
        A = Application.WorksheetFunction.Max(CompareRange)
     
              For Each y In CompareRange
                  If y = A Then
                  Billede = "C:\Ansatte\" & Range(y.Address).Offset(0, -1) & ".Jpg"
             
                Image1.Picture = LoadPicture(Billede)
             
                  Exit Sub
                End If
              Next y
End Sub

kabbak> det ser godt ud, men....
jeg ønsker at loade et specielt billede afhængig af hvem der fører.
Hvis de værdier jeg sammenligner ligger i f5:f9, så ligger de tilsvarende navne i b5:b9. navnene i cellerne er de samme som filnavnene.
Hvordan gøres dette?

hov....den skal selvfølgelig også kører med 10 min mellemrum....jeg har prøvet med Application.OnTime, men jeg kan ikke rigtigt få det til at virke...

i ThisWorkbook modulet

Public Sub Workbook_Open()
Nu = Now() + TimeSerial(0, 10, 0)
Application.OnTime Nu, "Opdater"
End Sub


i et rigtig modul

Public Sub Opdater()
  Dim CompareRange As Variant, y As Variant, A As Long, Billede As String
  With Sheets("Ark1")' ret arknavnet til dit ark
        Set CompareRange = .Range("f5:f9")
        A = Application.WorksheetFunction.Max(CompareRange)
     
              For Each y In CompareRange
                  If y = A Then
                  Billede = "C:\Ansatte\" & .Range(y.Address).Offset(0, -4) & ".Jpg"
             
                .Image1.Picture = LoadPicture(Billede)
             
                  Exit Sub
                End If
              Next y
      End With
        Nu = Now() + TimeSerial(0, 10, 0)
        Application.OnTime Nu, "Opdater"
     
End Sub

klasse...det virker....drop et svar

et svar ;-))