10. december 2007 - 22:18
Der er
5 kommentarer og
1 løsning
Udskriv oversigt
Hej
Jeg har følgende funktion på en knap i min userform.
Når man trykker er pointen, at man for den valgte medarbejder, kan indtaste et ugenr. og den opsummerer hvor mange timer personen har haft. Den tæller selv på informationer i et bagvedliggende ark.
Men er der nogle som kan lave en smartere funktion.
Jeg forestiller mig en som f.eks. åbner et vindue hvor man stadig kan vælge ugenr. (drop down eller lignende) men når man så vælger vises hele ugen på datoer hvad personen har lavet og opsummeret timerne. Fra dette lille oversigtsbillede kan man så også udskrive medarbejderens uge.
Informationer i Excel arket er:
Kolonne A = Medarbejdernr.
Kolonne B = Medarbejdernavn
Kolonne C = Projekt
Kolonne D = Dato (dd-mm-åå)(kan dække over flere år)
Kolonne E = Ugenr.
Kolonne F = Timer
Kolonne G = Udført arbejde
Nogle som vil hjælpe med en god ide og et eksempel.
Nuværende funktion.
Private Sub CommandButton1_Click()
Dim r, tal, last, t
last = Cells(65500, 1).End(xlUp).Row
e = InputBox("Indtast ugenr. ")
If e = "" Then Exit Sub
For t = 11 To last
If Cells(t, 5) = CDec(e) Then tal = tal + Cells(t, 6)
Next
If tal = 0 Then MsgBox ("Medarbejdernr. ") & Me.f_medarbnr & (" har ingen timer i uge ") & e: Exit Sub
MsgBox ("Medarbejdernr. ") & Me.f_medarbnr & (" har ") & tal & (" time(r) i uge ") & e
End Sub
23. december 2007 - 16:22
#5
Private Sub CommandButton1_Click()
Set sh = ActiveSheet 'Sheets("Ark1")
rk = sh.Cells(65500, 1).End(xlUp).Row
Me.ListBox1.Clear: Me.ListBox2.Clear: Me.ListBox3.Clear: Me.ListBox4.Clear For t = 11 To rk If Cells(t, "E") = Val(Me.ComboUge) And Year(Cells(t, "D")) =
Val(Me.ComboÅr) And Cells(t, "A") = Val(Me.TextBoxNr) Then Me.ListBox1.AddItem sh.Cells(t, "F"): ugeSum = ugeSum + sh.Cells(t, "F") 'timer Me.ListBox2.AddItem sh.Cells(t, "G") 'job Me.ListBox3.AddItem Format(sh.Cells(t, "D"), "dd-mm-yy") 'dato Me.ListBox4.AddItem sh.Cells(t, "C") 'projekt End If Next Me.TextBoxUgesum = ugeSum
End Sub
Private Sub CommandButton2_Click() 'Find Fra dato til dato
Set sh = ActiveSheet 'Sheets("Ark1") rk = sh.Cells(65500, 1).End(xlUp).Row
Me.ListBox1.Clear: Me.ListBox2.Clear: Me.ListBox3.Clear: Me.ListBox4.Clear For t = 11 To rk If Cells(t, "D") >= CDate(Me.FraDato) And Cells(t, "D") <= CDate(Me.TilDato) And Cells(t, "A") = Val(Me.TextBoxNr) Then Me.ListBox1.AddItem sh.Cells(t, "F"): ugeSum = ugeSum + sh.Cells(t, "F") 'timer Me.ListBox2.AddItem sh.Cells(t, "G") 'job Me.ListBox3.AddItem Format(sh.Cells(t, "D"), "dd-mm-yy") 'dato Me.ListBox4.AddItem sh.Cells(t, "C") 'projekt End If Next Me.TextBoxUgesum = ugeSum
End Sub
Private Sub CommandButtonPrint_Click() 'Find uge
If MsgBox("Print Form ? ", vbYesNo) = vbYes Then Set sh1 = Sheets("Udskriv")
sh1.Range("B2") = Me.TextBoxNavn & " - Uge " & Me.ComboUge & " - År " & Me.ComboÅr sh1.Range("B5:F100").ClearContents
For t = 0 To Me.ListBox1.ListCount - 1
sh1.Cells(t + 5, 2) = Me.ListBox3.List(t, 0) sh1.Cells(t + 5, 3) = Me.ListBox1.List(t, 0) sh1.Cells(t + 5, 4) = Me.ListBox4.List(t, 0) sh1.Cells(t + 5, 5) = Me.ListBox2.List(t, 0) Next End If Application.ScreenUpdating = False ark = ActiveSheet.Name: sh1.Select rk = sh1.Cells(100, 2).End(xlUp).Row sh1.Range("B" & rk + 1) = "Timer ialt"
sh1.Range("C" & rk + 1) = Me.TextBoxUgesum sh1.Range("B1:E" & rk + 1).Select UserForm1.Hide Selection.PrintPreview 'Selection.PrintOut sh1.Cells(1, 1).Select Sheets(ark).Select UserForm1.Show Application.ScreenUpdating = True
End Sub
Private Sub TextBox1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer) Calendar1.Visible = True
End Sub
