Indsætte data baseret på klokkeslæt.

Rettelse!

Teksten skal selvfølgelig ikke vises fra samme celle. Det skal se sådan ud:

Dvs. Hvis klokken i "center" er mellem:

08:30 - 09.59 vises teksten fra "rådgiver" celle n12
10:00 - 11.24 vises teksten fra "rådgiver" celle n13
11:25 - 11.59 vises teksten fra "rådgiver" celle n14
12:00 - 12.34 vises teksten fra "rådgiver" celle n15
12:35 - 13.09 vises teksten fra "rådgiver" celle n16
13:10 - 14.44 vises teksten fra "rådgiver" celle n17
14:45 - 08.29 (næste dag) vises teksten fra "rådgiver" celle n18

Håber virkelig at der er et geni der kan knække denne!

mvh

Steffen.

Hvornår opdateres den nævnte dataforbindelse?

I øjeblikket opdaterers blot manuelt med en makro, men med tiden skal den opdatere automatisk på netop begyndelsestidspunkterne.

Gør det en forskel?

mvh Steffen

Har skrevet en VBA-kode, der kan bestemme hvilken tekst, der skal vises i Center.

Opdateringen kan også ske automatisk via VBA-kode - idet der kan anvendes OnTime-funktionen.

Filen Rådgiver kan evt. åbnes automatisk via VBA.

VBA-koden er anbragt i Center "under Ark1"
I min model er begge xls-filr anbragt i samme mappe.
P.t. udføres VBA-koden manuelt.

Model kan fremsendes - @-adresse under min profil.
-------------------------------------------

Dim sti As String          'TIL TEST

Const rådgiverFilNavn = "Rådgiver.xlsx"

Const CenterVisningRange = "L22"
Dim xlsRådgiver As Object
Dim centerTider As Variant
Dim centerTekstRæk As Variant

Dim aktuelleTid As Date
Private Sub opdaterCenter()
Dim ix As Integer
    Housekeeping
   
    ix = beregnInterval(aktuelleTid)
    Range(CenterVisningRange) = hentTekstFraRådgiver(centerTekstRæk(ix))
End Sub
Private Sub Housekeeping()
    aktuelleTid = Format(Now, "hh:mm")
    centerTider = Array("08:30", "10:00", "11:25", "12:00", "12:35", "13:10", "14:45")
    centerTekstRæk = Array(12, 13, 14, 15, 16, 17, 18)
   
    sti = ActiveWorkbook.Path & "\"
   
End Sub
Private Function beregnInterval(ptTid)
Dim ct As Integer, cTid As Date
    For ct = 0 To UBound(centerTider)
        cTid = centerTider(ct)
        If cTid > ptTid Then
            beregnInterval = ct - 1
            Exit Function
        End If
    Next ct

    beregnInterval = UBound(centerTider)
End Function
Private Function hentTekstFraRådgiver(rækkeNr)
    Set xlsRådgiver = CreateObject("Excel.Application")
    With xlsRådgiver
        .Workbooks.Open sti & rådgiverFilNavn
        hentTekstFraRådgiver = .Range("N" & rækkeNr)
        .Application.Quit
    End With
    Set xlsRådgiver = Nothing
End Function