jeudi 12 avril 2012 18:50
I have a sheet set up for my staff to request holiday and a macro that will convert it to a word doc and email to whomever i require (see below). The preson recieveing the email will look in the holiday book(another workbook) and determine if the holiday can bae accepted/rejected/
I would like to take this one step further and have the macro do the following...
Workbook has 13 sheets > Jan-Dec and a total.
Each sheet has 24 rows and enough columns for days in the month> team 1 (10 members) and a total. team 2 (10 members) and a total. the next line on each calculates the percentage of people in the team off. Each day is 7.5 hours
A1 A2 A3 A4
1ST 2ND 3RD
STAFF 1 7.5 7.5
STAFF 2 7.5
STAFF 3 7.5
TOTAL 7.5 7.5
Percent 33.33 33.33 66.66 [(7.5/22.5)*100]
so i want the macro to first lookup the person on the total sheet and ensure the required holiday amount is available. if not reject the request as "not enough holiday"
if they have enough holiday see below
lookup the percentage of holiday used and if it is less than 75% send the form as a rejection. If it is above 75% send the form as approved then lookup the persons name depending on date (eg Holiday book 2012/January/1st - add the 7.5 holiday save and close the holiday book.
the only snag is that holiday is requested as a range so 01/04/12-01/04/12 = 1 day (7.5 hrs)...01/04/12-04/04/12 = (5days 37.5hrs)
Im asking a lot here but can it be done?
Sub LotusMail() Dim Maildb As Object Dim UserName As String Dim MailDbName As String Dim MailDoc As Object Dim attachME As Object Dim Session As Object Dim EmbedObj1 As Object Dim recipient As String Dim ccRecipient As String Dim bccRecipient As String Dim subject As String Dim bodytext As String Dim Attachment1 As String Dim Body As Object Dim recip() Application.ScreenUpdating = False Set wdApp = New Word.Application Set wdDoc = wdApp.Documents.Add Range("N4").Select Selection.Copy Range("C3:G3").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False ActiveSheet.Range("a1:G26").Copy wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste Application.CutCopyMode = False Range("N3").Select Selection.Copy Range("C3:G3,C5:G5,B7:B8,D7:D8,G7:G8,E16:F16").Select Range("E16").Activate Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Range("I14").Select Range("c3:g3").Select Application.CutCopyMode = False With wdApp.ActiveWindow If .View.SplitSpecial = wdPaneNone Then .ActivePane.View.Type = wdPrintView Else .View.Type = wdPrintView End If End With With wdApp.ActiveDocument.PageSetup .TopMargin = CentimetersToPoints(2) .BottomMargin = CentimetersToPoints(1.5) .LeftMargin = CentimetersToPoints(2.6) .RightMargin = CentimetersToPoints(1) .HeaderDistance = CentimetersToPoints(0) .FooterDistance = CentimetersToPoints(0) End With With wdDoc If Dir("C:\Temp\Holiday Request OOH.doc") <> "" Then Kill "C:\Temp\Holiday Request OOH.doc" End If .SaveAs ("C:\Temp\Holiday Request OOH.doc") .Close End With With wdApp .Quit End With MsgBox "Your holiday request has been sent to the management Team for Approval" ReDim Preserve recip(0) recip(0) = "test" ReDim Preserve recip(1) recip(1) = "test" 'ReDim Preserve recip(2) 'recip(2) = "OOH TM" ccRecipient = Application.UserName subject = "Holiday Request Form OOH" bodytext = "Please find Attached my Holiday Request Form" Set Session = CreateObject("Notes.NotesSession") UserName = Session.UserName MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf" Set Maildb = Session.GETDATABASE("", MailDbName) If Maildb.IsOpen <> True Then On Error Resume Next Maildb.OPENMAIL End If Set MailDoc = Maildb.CREATEDOCUMENT MailDoc.Form = "Memo" With MailDoc .sendto = recip .copyto = ccRecipient '.blindcopyto = bccRecipient .subject = subject .Body = bodytext End With ' saving message MailDoc.SAVEMESSAGEONSEND = True Attachment1 = ("C:\Temp\Holiday Request OOH.doc") If Attachment1 <> "" Then Set attachME = MailDoc.CREATERICHTEXTITEM("Attachment1") Set EmbedObj1 = attachME.EMBEDOBJECT(1454, "", Attachment1, "Attachment") MailDoc.CREATERICHTEXTITEM ("Attachment") End If MailDoc.PostedDate = Now() MailDoc.send 0, recipient Set Maildb = Nothing Set MailDoc = Nothing Set attachME = Nothing Set Session = Nothing Set EmbedObj1 = Nothing ActiveWorkbook.Saved = True ActiveWorkbook.Close End Sub
Toutes les réponses
lundi 16 avril 2012 08:14
Your problem is not clear to me. Do you want to calculate the days between two datetime? If so, you can use DateDiff function:
Wish a bright future!
- Modifié CassyDong lundi 16 avril 2012 08:15