![]() |
|
#4
|
|||
|
|||
|
Here is the second part.
'************************************************* ************************** '** GenerateInvoice F U N C T I O N '************************************************* ************************** Sub GenerateInvoice() Range("S_Function").Formula = "Generating Invoice Transactions" Range("S_Counter").Formula = 0 Sheets("Status").Visible = True Sheets("Status").Select Application.ScreenUpdating = False Sheets("Payroll_Entry").Select 'SortByCustomer On Error GoTo ErrorHandler ' Enable error-handling routine. ' Channel = Application.DDEInitiate("PeachW", COMPANY) ' DDEPoke Channel, "Password", Range("PWord") Sheets("Status").Select RPointer = PE_DATA_ROW Application.Calculation = xlManual Application.ScreenUpdating = True Do Until IsEmpty(Sheets("Payroll_Entry").Cells(RPointer, 13)) Or _ IsError(Sheets("Payroll_Entry").Cells(RPointer, 13)) If Sheets("Payroll_Entry").Cells(RPointer, 11) > 0 Then Channel = Application.DDEInitiate("PeachW", COMPANY) DDEPoke Channel, "Password", Range("PWord") ' Poke Invoice Header DDEPoke Channel, "file=salesjournal,clear,field=customer", _ Sheets("Payroll_Entry").Cells(RPointer, 12) DDEPoke Channel, "file=salesjournal,field=date", Range("PE_InvoiceDate") Do ' Poke Each Disbursment Range("S_Counter").Formula = RPointer - 7 Range("I_Account").Formula = ConvertDeptToAccount _ (Worksheets("Payroll_Entry").Cells(RPointer, 4).Value) Range("I_Amount").Formula = _ Worksheets("Payroll_Entry").Cells(RPointer, 15).Value * -1 Range("I_Quanity").Formula = _ Worksheets("Payroll_Entry").Cells(RPointer, 8).Value Range("I_Description").Formula = Format(Worksheets("Payroll_Entry"). _ Cells(RPointer, 7).Value, "00000") + " " + Format(Worksheets _ ("Payroll_Entry").Cells(RPointer, 6).Value, "mm/dd/yyyy") + _ " " + CStr(Worksheets("Payroll_Entry").Cells(RPointer, 2).Value) If Worksheets("Payroll_Entry").Cells(RPointer, 12) = _ Worksheets("Payroll_Entry").Cells(RPointer + 1, 12) _ Then DDEPoke Channel, "file=salesjournal,field=nextdistribution", _ Range("I_Distribution") _ Else DDEPoke Channel, "file=salesjournal,field=nextdistribution,save ", _ Range("I_Distribution") RPointer = RPointer + 1 Loop While Worksheets("Payroll_Entry").Cells(RPointer, 12) = _ Worksheets("Payroll_Entry").Cells(RPointer - 1, 12) Application.DDETerminate (Channel) Else RPointer = RPointer + 1 End If Loop Application.Calculation = xlAutomatic Application.ScreenUpdating = False ' Application.DDETerminate (Channel) Sheets("Payroll_Calc").Select Sheets("Status").Visible = False Exit Sub ' Exit Sub before error handler. ErrorHandler: ' Error-handling routine. Sheets("Status").Visible = False Sheets("Payroll_Calc").Select MsgBox ("The Peachtree accounting program must be running in the background before running this function. Start Peachtree then try again.") End End Sub '************************************************* ************************** '** GeneratePayroll F U N C T I O N '************************************************* ************************** Sub GeneratePayroll() Range("S_Function").Formula = "Generating Payroll Transactions" Range("S_Counter").Formula = 0 Sheets("Status").Visible = True Sheets("Status").Select Application.ScreenUpdating = False On Error GoTo ErrorHandler ' Enable error-handling routine. ' Channel = Application.DDEInitiate("PeachW", COMPANY) ' DDEPoke Channel, "Password", Range("PWord") RPointer = PC_DATA_ROW Range("P_CheckDate").Formula = Range("PE_CheckDate") Sheets("Status").Select Application.ScreenUpdating = True Do Until IsEmpty(Sheets("Payroll_Calc").Cells(RPointer, 2)) Or _ IsError(Sheets("Payroll_Calc").Cells(RPointer, 2)) Channel = Application.DDEInitiate("PeachW", COMPANY) DDEPoke Channel, "Password", Range("PWord") CPointer = PC_DIST_COLUMN Range("S_Counter").Formula = (RPointer - 8) / 2 ' Poke Payroll Header Range("P_Employee").Formula = _ Worksheets("Payroll_Calc").Cells(RPointer, 3) Range("P_RegHours").Formula = _ Worksheets("Payroll_Calc").Cells(RPointer, 4) Range("P_OTHours").Formula = _ Worksheets("Payroll_Calc").Cells(RPointer, 5) Range("P_SpecHours").Formula = _ Worksheets("Payroll_Calc").Cells(RPointer, 6) DDEPoke Channel, "file=payrolljournal,clear,field=date,field=employ ee,field=regularhours,field=overtimehours,field=sp ecialhours", Range("P_Header") ' Poke Each Disbursment Do Until IsEmpty(Worksheets("Payroll_Calc").Cells(7, CPointer)) Range("S_Counter").Formula = Format(((RPointer - 8) / 2) + _ ((CPointer - 6) / 100), "0.00") ' Poke First Disbursment If Worksheets("Payroll_Calc").Cells(RPointer + 1, CPointer) > 0 _ Then Range("P_Account").Formula = Worksheets("Payroll_Calc") _ .Cells(RPointer + 1, CPointer).Value _ Else Range("P_Account").Formula = Worksheets("Payroll_Calc") _ .Cells(7, CPointer).Value Range("P_Amount").Formula = Worksheets("Payroll_Calc") _ .Cells(RPointer, CPointer).Value Range("P_Field").Formula = Worksheets("Payroll_Calc") _ .Cells(6, CPointer).Value CPointer = CPointer + 1 If IsEmpty(Worksheets("Payroll_Calc").Cells(7, CPointer)) _ Then DDEPoke Channel, "file=payrolljournal,field=nextdistribution,sa ve", _ Range("P_Distribution") _ Else DDEPoke Channel, "file=payrolljournal,field=nextdistribution", _ Range("P_Distribution") Loop Application.DDETerminate (Channel) RPointer = RPointer + 2 Loop Application.ScreenUpdating = False ' Application.DDETerminate (Channel) Sheets("Payroll_Calc").Select Sheets("Status").Visible = False Exit Sub ' Exit Sub before error handler. ErrorHandler: ' Error-handling routine. Sheets("Status").Visible = False Sheets("Payroll_Calc").Select MsgBox ("The Peachtree accounting program must be running in the background before running this function. Start Peachtree then try again.") End End Sub '************************************************* ************************** '** GetPayroll F U N C T I O N '************************************************* ************************** Sub GetPayroll() ' Used only for test purposes Application.Calculation = xlManual RPointer = 2 Sheets("Test").Select Range("A1.AA9999").ClearContents On Error GoTo ErrorHandler ' Enable error-handling routine. Channel = Application.DDEInitiate("PeachW", COMPANY) DDEPoke Channel, "Password", Range("PWord") PAWData = DDERequest(Channel, "file=payrolljournal,first,field=employee,field=in voice,field=weeks,field=date,field=description,fie ld=account,field=amount,field=regularhours,field=o vertimehours,field=specialhours") While Not IsError(PAWData) For CPointer = LBound(PAWData) To UBound(PAWData) Worksheets("Test").Cells(RPointer, CPointer).Formula = PAWData(CPointer) Next CPointer RPointer = RPointer + 1 PAWDist = DDERequest(Channel, "file=payrolljournal,field=firstdistribution") While Not IsError(PAWDist) For CPointer = LBound(PAWDist) To UBound(PAWDist) Worksheets("Test").Cells(RPointer, CPointer + 1).Formula = _ PAWDist(CPointer) Next CPointer PAWDist = DDERequest(Channel, _ "file=payrolljournal,field=nextdistribution") RPointer = RPointer + 1 Wend PAWData = DDERequest(Channel, "file=payrolljournal,next,field=employee,field=inv oice,field=weeks,field=date,field=description,fiel d=account,field=amount,field=regularhours,field=ov ertimehours,field=specialhours") Wend Application.DDETerminate (Channel) Application.Calculation = xlAutomatic Exit Sub ' Exit Sub before error handler. ErrorHandler: ' Error-handling routine. Application.Calculation = xlAutomatic MsgBox ("The Peachtree accounting program must be running in the background before running this function. Start Peachtree then try again.") Exit Sub End Sub '************************************************* ************************** '** GetSales F U N C T I O N '************************************************* ************************** Sub GetSales() ' Used only for test purposes Application.Calculation = xlManual RPointer = 2 Sheets("Test").Select Range("A1.AA9999").ClearContents On Error GoTo ErrorHandler ' Enable error-handling routine. Channel = Application.DDEInitiate("PeachW", COMPANY) DDEPoke Channel, "Password", Range("PWord") PAWData = DDERequest(Channel, "file=salesjournal,first,field=invoice,field=date, field=description,field=account,field=amount") While Not IsError(PAWData) For CPointer = LBound(PAWData) To UBound(PAWData) Worksheets("Test").Cells(RPointer, CPointer).Formula = PAWData(CPointer) Next CPointer RPointer = RPointer + 1 PAWDist = DDERequest(Channel, "file=salesjournal,field=firstdistribution") While Not IsError(PAWDist) For CPointer = LBound(PAWDist) To UBound(PAWDist) Worksheets("Test").Cells(RPointer, CPointer + 1).Formula = _ PAWDist(CPointer) Next CPointer PAWDist = DDERequest(Channel, _ "file=salesjournal,field=nextdistribution") RPointer = RPointer + 1 Wend PAWData = DDERequest(Channel, "file=salesjournal,next,field=invoice,field=date,f ield=description,field=account,field=amount") Wend Application.DDETerminate (Channel) Application.Calculation = xlAutomatic Exit Sub ' Exit Sub before error handler. ErrorHandler: ' Error-handling routine. Application.Calculation = xlAutomatic MsgBox ("The Peachtree accounting program must be running in the background before running this function. Start Peachtree then try again.") Exit Sub End Sub '************************************************* ************************** '** PayFrequencyAnnualConvFactor F U N C T I O N '************************************************* ************************** Function PayFrequencyAnnualConvFactor(Employee) PayFrequency = Range("Employee_List!A5").Offset(Employee, EL_PAY_FREQ - 1) Select Case PayFrequency Case "Weekly" PayFrequencyAnnualConvFactor = 52 Case "Bi-Weekly" PayFrequencyAnnualConvFactor = 26 Case "Semi-Monthly" PayFrequencyAnnualConvFactor = 24 Case "Monthly" PayFrequencyAnnualConvFactor = 12 Case Else PayFrequencyAnnualConvFactor = 1 End Select End Function '************************************************* ************************** '** PrintSheet P R O C E D U R E '************************************************* ************************** Sub PrintSelectedSheet() ActiveWindow.SelectedSheets.PrintOut Copies:=1 End Sub '************************************************* ************************** '** ResetPayrollEntry P R O C E D U R E '************************************************* ************************** Sub ResetPayrollEntry() Application.ScreenUpdating = False Sheets("Payroll_Entry").Unprotect Sheets("Payroll_Entry").Range(Rows(PE_DATA_ROW), Rows(999)).Delete Shift:=xlUp Range("PE_Formula").EntireRow.Hidden = False Sheets("Payroll_Entry").Range("PE_Formula").Copy ' Formula row ActiveSheet.Paste destination:=Sheets("Payroll_Entry").Rows(PE_DATA_ ROW) Range("PE_Formula").EntireRow.Hidden = True DefinePayrollEntryFormulas ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True SendKeys ("^{Home}") End Sub '************************************************* ************************** '** SetDevelopmentEnv F U N C T I O N '************************************************* ************************** Sub SetDevelopmentEnv() Application.ScreenUpdating = False ' Workbook settings ActiveWindow.WindowState = xlNormal Application.DisplayFormulaBar = True Toolbars(1).Visible = True ' Payroll_Entry screen settings Sheets("Payroll_Entry").Select ActiveSheet.Unprotect Rows("5:5").EntireRow.Hidden = False Columns("P:P").EntireColumn.Hidden = False ActiveWindow.DisplayHeadings = True ' Payroll_Calc screen settings Sheets("Payroll_Calc").Select ActiveSheet.Unprotect Rows("4:6").EntireRow.Hidden = False Columns("J:Z").EntireColumn.Hidden = False Columns("AL:AO").EntireColumn.Hidden = False ActiveWindow.DisplayHeadings = True ' Payroll_Sum screen settings Sheets("Payroll_Sum").Select ActiveSheet.Unprotect ActiveWindow.DisplayHeadings = True ' Dept_Sum screen settings Sheets("Dept_Sum").Select ActiveSheet.Unprotect ActiveWindow.DisplayHeadings = True ' Customer_List screen settings Sheets("Customer_List").Select ActiveSheet.Unprotect ActiveWindow.DisplayHeadings = True ' Employee_List screen settings Sheets("Employee_List").Select ActiveSheet.Unprotect ActiveWindow.DisplayHeadings = True ' Status screen settings Sheets("Status").Visible = True Sheets("Status").Select ActiveSheet.Unprotect ActiveWindow.DisplayHeadings = True ' Work screen settings Sheets("Work").Visible = True Sheets("Work").Select ActiveSheet.Unprotect ActiveWindow.DisplayHeadings = True ' Logic screen settings Sheets("Logic").Visible = True Sheets("Logic").Select ActiveSheet.Unprotect Sheets("Payroll_Entry").Select End Sub '************************************************* ************************** '** SetProductionEnv F U N C T I O N '************************************************* ************************** Sub SetProductionEnv() Application.ScreenUpdating = False DefineNamedRanges ' Workbook settings ActiveWindow.WindowState = xlMaximized Application.DisplayFormulaBar = False Toolbars(1).Visible = False Toolbars(2).Visible = False Toolbars(5).Visible = False ' Payroll_Entry screen settings Sheets("Payroll_Entry").Select ActiveSheet.Unprotect Rows("5:5").EntireRow.Hidden = True Columns("P:P").EntireColumn.Hidden = True ActiveWindow.DisplayHeadings = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True SendKeys ("^{Home}") ' Payroll_Calc screen settings Sheets("Payroll_Calc").Select ActiveSheet.Unprotect Rows("4:6").EntireRow.Hidden = True Columns("J:Z").EntireColumn.Hidden = True Columns("AL:AO").EntireColumn.Hidden = True ActiveWindow.DisplayHeadings = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True SendKeys ("^{Home}") ' Payroll_Sum screen settings Sheets("Payroll_Sum").Select ActiveWindow.DisplayHeadings = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True SendKeys ("^{Home}") ' Dept_Sum screen settings Sheets("Dept_Sum").Select ActiveWindow.DisplayHeadings = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True SendKeys ("^{Home}") ' Customer_List screen settings Sheets("Customer_List").Select ActiveWindow.DisplayHeadings = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True SendKeys ("^{Home}") ' Employee_List screen settings Sheets("Employee_List").Select ActiveWindow.DisplayHeadings = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True SendKeys ("^{Home}") ' Status screen settings Sheets("Status").Visible = True Sheets("Status").Select ActiveWindow.DisplayHeadings = False ActiveSheet.Visible = False ' Work screen settings Sheets("Work").Visible = True Sheets("Work").Select ActiveWindow.DisplayHeadings = False ActiveSheet.Visible = False ' Logic screen settings Sheets("Logic").Visible = False Sheets("Payroll_Entry").Select End Sub '************************************************* ************************** '** SIT F U N C T I O N '************************************************* ************************** Function SIT(Employee, AdjGross) If IsError(Employee) Then SIT = 0: Exit Function ConvFactor = PayFrequencyAnnualConvFactor(Employee) AnnualGross = (AdjGross * ConvFactor) - _ (Range("Employee_List!A5").Offset(Employee, EL_STATE_ALLOW - 1) * 2250) If Range("Employee_List!A5").Offset(Employee, EL_STATUS - 1) = "Single" Then If AnnualGross <= 3000 Then Table = 0 ElseIf AnnualGross <= 18000 Then Table = (AnnualGross - 3000) * 0.035 ElseIf AnnualGross <= 33000 Then Table = 525 + ((AnnualGross - 18000) * 0.0625) Else Table = 1462.5 + ((AnnualGross - 33000) * 0.0645) End If Else If AnnualGross <= 6000 Then Table = 0 ElseIf AnnualGross <= 36000 Then Table = (AnnualGross - 6000) * 0.035 ElseIf AnnualGross <= 66000 Then Table = 1050 + ((AnnualGross - 36000) * 0.0625) Else Table = 2925 + ((AnnualGross - 66000) * 0.0645) End If End If SIT = -Application.Round((Table / ConvFactor) + _ Range("Employee_List!A5").Offset(Employee, EL_EXTRA_SIT - 1), 2) End Function '************************************************* ************************** '** SortByCustomer P R O C E D U R E '************************************************* ************************** Sub SortByCustomer() Application.ScreenUpdating = False Sheets("Payroll_Entry").Select Sheets("Payroll_Entry").Unprotect Range("PE_Data").Sort Key1:=Range("L8"), Order1:=xlAscending, Key2:=Range _ ("F8"), Order2:=xlAscending, Key3:=Range("G8"), Order3:=xlAscending, _ Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Sheets("Payroll_Entry").Protect DrawingObjects:=True, Contents:=True, _ Scenarios:=True SendKeys ("^{Home}") End Sub '************************************************* ************************** '** SortByBillRate P R O C E D U R E '************************************************* ************************** Sub SortByBillRate() Application.ScreenUpdating = False Sheets("Payroll_Entry").Select Sheets("Payroll_Entry").Unprotect Range("PE_Data").Sort Key1:=Range("K8"), Order1:=xlAscending, Key2:=Range _ ("L8"), Order2:=xlAscending, Key3:=Range("G8"), Order3:=xlAscending, _ Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Sheets("Payroll_Entry").Protect DrawingObjects:=True, Contents:=True, _ Scenarios:=True SendKeys ("^{Home}") End Sub '************************************************* ************************** '** SortByDate P R O C E D U R E '************************************************* ************************** Sub SortByDate() Application.ScreenUpdating = False Sheets("Payroll_Entry").Select Sheets("Payroll_Entry").Unprotect Range("PE_Data").Sort Key1:=Range("F8"), Order1:=xlAscending, Key2:=Range _ ("C8"), Order2:=xlAscending, Key3:=Range("G8"), Order3:=xlAscending, _ Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Sheets("Payroll_Entry").Protect DrawingObjects:=True, Contents:=True, _ Scenarios:=True SendKeys ("^{Home}") End Sub '************************************************* ************************** '** SortByDepartment P R O C E D U R E '************************************************* ************************** Sub SortByDepartment() Application.ScreenUpdating = False Sheets("Payroll_Entry").Select Sheets("Payroll_Entry").Unprotect Range("PE_Data").Sort Key1:=Range("D8"), Order1:=xlAscending, Key2:=Range _ ("L8"), Order2:=xlAscending, Key3:=Range("F8"), Order3:=xlAscending, _ Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Sheets("Payroll_Entry").Protect DrawingObjects:=True, Contents:=True, _ Scenarios:=True SendKeys ("^{Home}") End Sub |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| Macros & Passwords | paulrm906 | Excel | 0 | 03-04-2006 01:30 AM |
| Self Help Books for Macros? | KRB | Excel | 0 | 11-22-2005 01:33 PM |