Thread: [Solved] Macros problem with XP
View Single Post
 
Old 06-20-2005, 05:02 PM
Gretchen Hembree
Guest
 
Posts: n/a
Default RE: Macros problem with XP

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
Reply With Quote