10. december 2007 - 22:18Der 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
I lang tid har samarbejdsbranchen fokuseret på at forbedre enhedsfunktioner – bedre kameraer, klarere lyd og smartere software. Men den virkelige forvandling handler ikke om funktioner.
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
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
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
