POPUP på dato og tid i en celle

Hvordan kommer cellerne ind i billedet?

Det er en vagtplan, hvor øverste linie er datoer og kolonnerne er de enkelte vognnumre. Jeg har typsik skrevet et tal i dem...

mvh Johnny

Ok - hvor er alarmtidspunktet placeret?

Ja, jeg har jo ikke noget. Men du mener, at jeg skal oprette en celle med klokkeslet? Det junne være D2.

Mvh

Johnny

Som eksempel kan jeg nævne at jeg har indlagt datoer i et excel-ark, via VBA overført "alarmtidspunkt" til Outlook-kalender. D.v.s. at kommer PopoUp når tidspunktet er nået. Dette kunne nok også indbygges i din vagtplan.

Lyder som om, det er det.
Jeg vil da gerne prøve.

mvh Johnny

Vender tilbage..

Rem Reference til Microsoft Outlook 12.0 Object Library er sat
Rem Kan ændres via Alt+F11 / Tools / References
Rem ==========================================================
Private Sub opdaterIOutlook(datokl, meddelelse)
Dim olApp, Namespace, myCalendar
   
    Set olApp = CreateObject("Outlook.Application")
    Set Namespace = olApp.GetNamespace("MAPI")
    Set obs = Namespace.GetDefaultFolder(olFolderCalendar).Items

    Set obs = olApp.CreateItem(olAppointmentItem)

    obs.Start = datokl
    obs.Subject = meddelelse
    obs.ReminderSet = True
    obs.Save
End Sub
Rem -------------------------------------
Rem DOBBELTKLIK - Slet Outlook meddelelse
Rem -------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim ræk As Long, dag As Date
    If Target.Column = 3 And Target <> "" Then
        Cancel = True
        ræk = Target.Row
        If IsDate(Range("A" & ræk)) = True Then
            dag = Format(Range("A" & ræk), "dd-mm-yyyy")
            If sletkalender(dag, Range("B" & ræk)) = True Then
                Target = ""
            Else
                MsgBox "Aftalen blev ikke fundet i Outlook"
            End If
        End If
    End If
End Sub
Public Function sletkalender(dato, søgEfter)
    Set olApp = CreateObject("Outlook.Application")
    Set Namespace = olApp.GetNamespace("MAPI")

    startdag = Format(dato, "dd-mm-yyyy") & " 00:00"
    slutdag = Format(dato, "dd-mm-yyyy") & " 23:59"
   
    Set myCal = Namespace.GetDefaultFolder(olFolderCalendar).Items
   
    Set aftale = myCal.Find("[Start] >= """ & _
        startdag & """ and [Start] <= """ & slutdag & """")
       
    While TypeName(aftale) <> "Nothing"
        emne = aftale.Subject
        If LCase(emne) = LCase(søgEfter) Then
            aftale.Delete
            sletkalender = True
            Exit Function
        End If
       
        Set aftale = myCal.FindNext
    Wend

    sletkalender = False
End Function

Rem ++++++++++++++++++++++++++++++++++++
Rem HØJREKLIK - Opret Outlook meddelelse
Rem ++++++++++++++++++++++++++++++++++++
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim ræk As Long
Rem Automatisk opdatering, hvis højreklik er i C1 - alle ikke opdaterede rækker opdateres i Outlook
    If Target.Column = 3 And Target.Row = 1 Then
        Cancel = True
        For ræk = 2 To 65000
            If Range("A" & ræk) = "" Then
                Exit Sub
            Else
                If IsDate(Range("A" & ræk)) = True And Range("C" & ræk) = "" Then
                    opdaterIOutlook Range("A" & ræk), Range("B" & ræk)
                    Range("C" & ræk) = Now
                End If
            End If
        Next ræk
    Else
        If Target.Column = 3 And Target = "" Then
            Cancel = True
            ræk = Target.Row
            If IsDate(Range("A" & ræk)) = True Then
                opdaterIOutlook Range("A" & ræk), Range("B" & ræk)
                Target = Now
            End If
        End If
    End If
End Sub