Hjælp til msg-box ved indtastning af ferie.

Jep - ved det :-)

Du kunne jo overveje at placere dagene nedefter.

På selve arkets faneblad højreklikes og vælges vis kode. Her placeres f.eks. koden (ret selv området til)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rInputRange As Range
    ' Det område der skal påvirkes
    Set rInputRange = Range("B2:h366")
   
    If Not Intersect(Target, rInputRange) Is Nothing Then
        Target.Value = InputBox("Indtast K eller F", "Indtastning")
    End If
End Sub

Nae - det var også min første tanke, men overskueligeheden går fløjten så.

Jaja, men makroen virker uanset hvordan person/uge vender

Flemming - makroen er fin til den ene del. Jeg ønsker den således, at når man har angivet ugedagen i msg-boxen, så placerer den k´et eller F´et på et bestemt sted i cellen, der svarer til - under:

M|T|O|T|F

Altså så Eks. F´et stiller sig under M´et hvis der er indtastet mandag..

Forstår jeg det rigtigt, at du vil bruge nogle mellemrum mv. til at finde den rigtige plads ?
Hvis det er tilfældet, mener jeg, at det er en skod løsning. Specielt når der anden gang skrives i samme celle!!! Det kan selvfølgelig laves, så det fungerer, but not in my sparetime.

Alternativt kunne laves noget med, at der kun kan planlægges et vist antal uger frem (rest kolonner / 5 arbejdsdage) - eks kolonne B-IV -> 255/5=51 uger. Så kunne en makro slette kolonnerne med en gammel uge og tilføje en ny i slutningen ! Nu har du et system der virker løbende også henover årsskiftet mv.

Ja - du har sgu nok ret, jeg havde ikke tænkt på det med flere indtastninger. Ville det være bøvlet at lave en makro der sletter gamle uger og indsætter nye ???

Nej. Jeg har faktisk lave noget ligenede før. Booking-system for en hundepension. Gad vide om ikke jeg kan finde den i aften. Smid mig en mail fd@win-consult.com så mailer jeg et eller andet senere (vises også her)

Tak Flemming - mail er afsendt.

Mile, jeg smed lige en model afsted til dig, som også indeholder nogle af de problemstillinger du beskriver ... God weekend :-)

Her er mit bud på en makro - hele regnearket kan fåes, hvis du skriver til mig på fd@smartoffice.dk og beder om SmartOffice - DayPlaner.xls (er sendt til MILE)

Private Sub cmdWeekRotate_Click()
    Dim rStartCell As Range
    Dim iDays As Long
    Dim sTemp As String
    Dim iCount As Integer
   
    Set rStartCell = Range("B2")
    iDays = 5
    sTemp = " "
   
    Do Until IsNumeric(sTemp) Or sTemp = ""
        sTemp = InputBox("Indtast ANTAL uger du vil slette / indsætte", "Ugenummer skift")
        If Not (IsNumeric(sTemp) Or sTemp = "") Then
            MsgBox "Du indtastede ikke et tal!!! Prøv igen", vbCritical, "Brugerfejl"
        End If
    Loop
   
    If sTemp = "" Then GoTo Finito
   
    iDays = iDays * CInt(sTemp)
   
    Range(Cells(2, 2), Cells(2, iDays + 1)).EntireColumn.Delete
   
    Set rStartCell = Range(Range("B2").End(xlToRight).Offset(0, 1).Address)
   
    For iCount = 1 To CInt(sTemp)
        iDays = iCount * 5
        rStartCell.Offset(-1, -5 + iDays).Value = rStartCell.Offset(-1, -10 + iDays).Value + 1
        rStartCell.Offset(0, -5 + iDays).Value = "M"
        rStartCell.Offset(0, -4 + iDays).Value = "T"
        rStartCell.Offset(0, -3 + iDays).Value = "O"
        rStartCell.Offset(0, -2 + iDays).Value = "T"
        rStartCell.Offset(0, -1 + iDays).Value = "F"
        With Range(Cells(rStartCell.Offset(-1, -5 + iDays).Row, rStartCell.Offset(-1, -5 + iDays).Column), _
              Cells(rStartCell.Offset(-1, -1 + iDays).Row, rStartCell.Offset(-1, -1 + iDays).Column))
            .HorizontalAlignment = xlCenter
            .Merge
        End With
    Next iCount
   
Finito:
    Set rStartCell = Nothing
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sInputCells As Range
    Set sInputCells = Range("B3:IV50")
   
    If Not Intersect(Target, sInputCells) Is Nothing Then
        Dim sTemp As String
        sTemp = InputBox("Indtast S (syg), K (kursus) eller F (ferie)", "Indtastning")
        If Len(sTemp) = 1 Then
            Target.Value = UCase(sTemp)
        Else
            MsgBox "Du har indtastet mere end en karakter - dur ikke", vbCritical, "Brugerfejl"
        End If
    End If
   
    Set sInputCells = Nothing
End Sub

Jan>> jeg vil gerne se dit forslag - jeg har sendt dig mit.

Flemming jeg har skrevet til dig vedr. din udmærkede kode.

Jan jeg har valgt at bruge din idé om betinget formattering. Har sendt lille hyggemail til dig også...

Hej

Flemming tak for koden og rettelsen vedr. ugenummer. Du får pointsene. Jan dit var også skidegodt (dette kan jeg sagtens bruge i anden sammenhæng). Håber at det er OK at du bliver tilskrevet lidt på den alternative konto

:-) +++++++

;-) den alternative konto kan være helt ok

Hej Mile
Helt ok med mig :-)
Er antallet af "+" = "point" på den alternative konto?

Hej Jan

Jep - Vi får travlt - dig og mig og Christa :-)

Hmmm ;-)

Åhhh....