Gentaende begivenheder med en 15/27 roation

Jeg tror godt jeg kan hjælpe dig - så der er måske håb.

Forslag er færdigt - send en mail til: pb@supertekst-it.dk - så returnerer jeg dette.

Ser ok ud. Er der mulighed for at man selv kan døbe dem f.eks. Jacob. Det er fordi, jeg gerne vil kunne lægge flere ind i samme kalender, da min bror også laver det samme. ville så gerne kunne lave  det så der kan laves fleter serier i outlook. Er det nøvendigt der står "fri" de dage jeg ikke er ude?

Og så kommer første dag ikke med f.eks udrejse d.22/10/07 så er første arbejds dag d.23

Kommentarer afventes...

Undskyld, har bare 1000 ting i gang, privat..
Den ser da super ud..
Lige et par Q
Kan jeg ikke lave den som et add i outlook?
Kan man lave det som en serie, så når man nu har "glemt" datoen for indtastning, og skifter crew så "bare" kan slette serien?

Som et add, mener jeg at det lægger sig i f.eks. funktioner, eller ligende.

Ok - vender tilbage senere...

Koden i Userform:

Dim antalOprettet
Private Sub CommandButton1_Click()
Dim startDato As Date, slutDato As Date, antalDage As Byte, emne As String
Dim dato As Date
   
    antalOprettet = 0
   
    System.Cursor = wdCursorWait
   
Rem arbejdsperiodens start = startdato
    startDato = Me.TextBox1
'    startDato = DateAdd("d", 1, startDato)
   
    slutDato = DateAdd("yyyy", 2, startDato)
'    slutDato = DateAdd("m", 3, startDato)          'TEST
    dato = startDato
   
Rem Afsæt arbejdsperioden
    For d = startDato To slutDato
            emne = Me.TextBox2
            antalDage = 15
       
        For f = 1 To antalDage
            opretAftaler d, emne
            d = DateAdd("d", 1, d)
        Next f

Rem ryk 27 dage fremtil næste arbejdsperiode
        d = DateAdd("d", 27, d)
    Next d
   
    System.Cursor = wdCursorNormal
   
    MsgBox (CStr(antalOprettet) + " aftaler er oprettet")
   
    Unload UserForm1
End Sub
Private Sub CommandButton2_Click()
    Unload UserForm1
End Sub
Private Sub CommandButton3_Click()
    sletFlag = True
    sletaftaler Me.TextBox2
    Unload UserForm1
End Sub
Private Sub TextBox1_Change()
    If Me.TextBox1 <> "" And IsDate(Me.TextBox1) = True And Len(Me.TextBox1) = 8 And Me.TextBox2 <> "" Then
        Me.CommandButton1.Enabled = True
        Me.CommandButton3.Enabled = True
        Me.CommandButton1.SetFocus
    Else
        Me.CommandButton1.Enabled = False
    End If
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Me.TextBox2 <> "" And Me.TextBox1 <> "" And IsDate(Me.TextBox1) = True And Len(Me.TextBox1) = 8 Then
        Me.CommandButton1.Enabled = True
        Me.CommandButton3.Enabled = True
        Me.CommandButton1.SetFocus
    Else
        Me.CommandButton1.Enabled = False
'        Me.CommandButton3.Enabled = False
    End If
End Sub
Private Sub opretAftaler(dato, emne)
Dim olApp, Namespace, myCalendar, aftale
    Set olApp = CreateObject("Outlook.Application")
    Set Namespace = olApp.GetNamespace("MAPI")

    Set aftale = olApp.CreateItem(olAppointmentItem)

    aftale.Start = dato
    aftale.Subject = emne
    aftale.ReminderSet = False
    aftale.AllDayEvent = True
    aftale.Save
   
    antalOprettet = antalOprettet + 1
End Sub
Private Sub sletaftaler(emne)
Dim olApp, myCal, myItem, Namespace, antal, antalSlettede

    Set olApp = CreateObject("Outlook.Application")
    Set Namespace = olApp.GetNamespace("MAPI")
    Set myCal = Namespace.GetDefaultFolder(olFolderCalendar)
   
    antalSlettede = 0
   
    antal = myCal.Items.Count
   
    For f = antal To 1 Step -1
        If InStr(LCase(myCal.Items(f).Subject), LCase(emne)) > 0 Then
            t = myCal.Items(f).Subject
            myCal.Items(f).Delete
            antalSlettede = antalSlettede + 1
        End If
    Next
   
    MsgBox (CStr(antalSlettede) + " aftaler vedr.: " + emne + " er slettet")
    Me.TextBox2 = ""
End Sub
Private Sub UserForm_activate()

End Sub