Files
jimmycheung93/task4/1/Common.bas
louiscklaw 1b62961605 update,
2025-02-01 02:02:37 +08:00

327 lines
8.9 KiB
QBasic

Attribute VB_Name = "Common"
Option Explicit
' get row number for a given username
Function GetIdxByUsername(username As String) As Integer
Dim result_idx As Integer
Dim i As Integer
result_idx = -1
For i = 1 To Var.MAX_NUM_OF_SALES
If (username = usernames(i)) Then
result_idx = i
Exit For
End If
Next i
GetIdxByUsername = result_idx
End Function
' get age from account sheet for a given username
Function LookupAge(username As String) As String
Dim lookup_result As String
Dim i As Integer
For i = 1 To Var.MAX_NUM_OF_SALES
If (username = usernames(i)) Then
lookup_result = ages(i)
Exit For
End If
Next i
LookupAge = lookup_result
End Function
' get team from account sheet for a given username
Function LookupTeam(username As String) As String
Dim lookup_result As String
Dim i As Integer
For i = 1 To Var.MAX_NUM_OF_SALES
If (username = usernames(i)) Then
lookup_result = teams(i)
Exit For
End If
Next i
LookupTeam = lookup_result
End Function
Sub GenTextReport()
Dim sPath As String
Dim calc_result As Variant
Var.AgentSalesMeta = ReadAgentSalesWorkbook.Run(Var.agentSalesFilePath)
Var.ProductSalesMeta = ReadProductSalesWorkbook.Run(Var.productSalesPath)
Var.AgentWorkingPerformanceMeta = ReadAgentWorkingPerfWorkbook.Run(Var.agentWorkingPerformancePath)
Var.CombinedSalesMeta = Array(Var.AgentSalesMeta, Var.ProductSalesMeta, Var.AgentWorkingPerformanceMeta)
Dim file_path As String
file_path = Var.output_report_directory & "\output_report.xlsx"
' empty workbook
' EmptyWorkbook (file_path)
' delete file if exist
Common.DeleteFileIfExist (file_path)
Common.createNewXlsx (file_path)
Dim wb As Workbook
Set wb = Workbooks.Open(file_path)
If frmMain.chkSalesAnalysisRpt.Value = True Then
' SAMonthAndQuart
calc_result = CalcSalesAnalysisMonthlyAndQuart(Var.CombinedSalesMeta)
WriteSalesAnalysisMonthlyAndQuart calc_result, file_path, wb
End If
If frmMain.chkProductAnalysisRpt.Value = True Then
' write sales analysis product category
' SAProductCategory
calc_result = CalcSalesAnalysisFileSalesAmount(Var.CombinedSalesMeta)
WriteSalesAnalysisFileSalesAmount calc_result, file_path, wb
End If
If frmMain.chkProductAnalysisRpt.Value = True Then
calc_result = CalcSalesAnalysisFileSalesUnit(Var.CombinedSalesMeta)
WriteSalesAnalysisFileSalesUnit calc_result, file_path, wb
End If
If frmMain.chkAgentPerformanceAnalysisRpt.Value = True Then
calc_result = APAnalysis_Calc(Var.CombinedSalesMeta)
APAnalysis_WriteTable calc_result, file_path, wb
End If
If frmMain.chkNoOfCasesRpt.Value = True Then
calc_result = NoOfCasesTable_Calc(Var.CombinedSalesMeta)
NoOfCasesTable_WriteTable calc_result, file_path, wb
End If
wb.Save
wb.Close
MsgBox "generate report done"
Debug.Print "done"
End Sub
Sub GenChartReport()
Dim sPath As String
Dim calc_result As Variant
Dim file_path As String
' NOTE: for debug work
sPath = "C:\temp\xlsx\Agent_Sales.xlsx"
Var.AgentSalesMeta = ReadAgentSalesWorkbook.Run(sPath)
' NOTE: for debug work
sPath = "C:\temp\xlsx\Product_Sales.xlsx"
Var.ProductSalesMeta = ReadProductSalesWorkbook.Run(sPath)
' NOTE: for debug work
sPath = "C:\temp\xlsx\Agent_Working_Performance.xlsx"
Var.AgentWorkingPerformanceMeta = ReadAgentWorkingPerfWorkbook.Run(sPath)
Var.CombinedSalesMeta = Array(Var.AgentSalesMeta, Var.ProductSalesMeta, Var.AgentWorkingPerformanceMeta)
' Const file_path As String = "D:\_workspace\carousell-comission-playlist\jimmycheung93\task4\_poc\main_xlsm\helloworld_graph.xlsm"
' creasteXlsm(FILE_PATH)
file_path = Var.output_report_directory & "\output_report_chart.xlsx"
' vba delete file if exist
DeleteFileIfExist (file_path)
createNewXlsx (file_path)
'EmptyWorkbook (file_path)
Dim wb As Workbook
Set wb = Workbooks.Open(file_path)
If frmMain.chkSalesAnalysisMonthAndQuartery.Value = True Then
' Sales Analysis (Monthly & Quartery)
AddSheet file_path, "Sales Analysis Monthly_Quartery"
calc_result = CalcSalesAnalysisMonthlyAndQuart(CombinedSalesMeta)
SAMonthAndQuartGraph.MonthlySalesAmountTable calc_result, file_path
SAMonthAndQuartGraph.MonthlySalesAmountGraph file_path
SAMonthAndQuartGraph.MonthlySalesComissionTable calc_result, file_path
SAMonthAndQuartGraph.MonthlySalesComissionGraph file_path
End If
If frmMain.chkSalesAnalysisProductCategory.Value = True Then
' Sales Analysis (Product Category)
AddSheet file_path, "Sales Analysis Product Category"
calc_result = CalcSalesAnalysisFileSalesAmount(CombinedSalesMeta)
SAProdCatGraph.SalesAmountTable calc_result, file_path, 1
SAProdCatGraph.SalesAmountGraph calc_result, file_path, 1
calc_result = CalcSalesAnalysisFileSalesUnit(CombinedSalesMeta)
SAProdCatGraph.SalesUnitTable calc_result, file_path, 1
SAProdCatGraph.SalesUnitGraph calc_result, file_path, 1
End If
If frmMain.chkAgentPerformanceAnalysis.Value = True Then
' Agent performance analysis(Comm
AddSheet file_path, "Agent performance analysis"
calc_result = APAnalysis_Calc(CombinedSalesMeta)
APAnalysisGraph.TeamATotalSalesCommisionPerformanceTable calc_result, file_path
APAnalysisGraph.TeamATotalSalesCommisionPerformanceGraph calc_result, file_path
APAnalysisGraph.TeamBTotalSalesCommisionPerformanceTable calc_result, file_path
APAnalysisGraph.TeamBTotalSalesCommisionPerformanceGraph calc_result, file_path
' Rank of agent's sales commission (monthly)
APAnalysisGraph.RankOfAgentSalesCommMonthlyTable calc_result, file_path
APAnalysisGraph.RankOfAgentSalesCommMonthlyGraph calc_result, file_path
End If
If frmMain.chkCasePersistency.Value = True Then
' Case persistency
AddSheet file_path, "Case persistency"
calc_result = NoOfCasesTable_Calc(CombinedSalesMeta)
CasePersistencyGraph.TeamACaseDistributionTable calc_result, file_path
CasePersistencyGraph.TeamACaseDistributionGraph calc_result, file_path
CasePersistencyGraph.TeamBCaseDistributionTable calc_result, file_path
CasePersistencyGraph.TeamBCaseDistributionGraph calc_result, file_path
End If
wb.Save
wb.Close
MsgBox "generate report done"
Debug.Print "done"
End Sub
Function DeleteFileIfExist(file_path As String)
On Error GoTo eh
If Dir(file_path) <> "" Then
Kill file_path
End If
Done:
Exit Function
eh:
Debug.Print "DeleteFileIfExist:Error: " & Err.Description
End Function
Function createNewXlsx(file_path As String)
Dim wb As Workbook
Set wb = Workbooks.Add
wb.SaveAs file_path
wb.Close
End Function
Function SortArray(ByRef arr() As Double) As Double()
Dim i As Long, j As Long
Dim temp As Variant
For i = LBound(arr) To UBound(arr) - 1
For j = i + 1 To UBound(arr)
If arr(i) < arr(j) Then
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
End If
Next j
Next i
SortArray = arr
End Function
Function AddSheet(ByVal file_path As String, ByVal sheet_name As String)
Dim wb As Workbook
Dim ws As Worksheet
' Open the workbook
Set wb = Workbooks.Open(file_path)
' Check if the sheet exists
On Error Resume Next
Set ws = wb.Sheets(sheet_name)
On Error GoTo 0
' If not found, create a new sheet
If ws Is Nothing Then
Set ws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
ws.Name = sheet_name
Else
' Empty the entire sheet
ws.UsedRange.ClearContents
End If
End Function
Function GetQuarterFromMonth(ByVal month As Integer) As Integer
GetQuarterFromMonth = Int((month - 1) / 3) + 1
End Function
Function ConvLetterMonthToIntMonth(str_letter_month As String)
Select Case str_letter_month
Case "Jan"
ConvLetterMonthToIntMonth = "1"
Case "Feb"
ConvLetterMonthToIntMonth = "2"
Case "Mar"
ConvLetterMonthToIntMonth = "3"
Case "Apr"
ConvLetterMonthToIntMonth = "4"
Case "May"
ConvLetterMonthToIntMonth = "5"
Case "Jun"
ConvLetterMonthToIntMonth = "6"
Case "Jul"
ConvLetterMonthToIntMonth = "7"
Case "Aug"
ConvLetterMonthToIntMonth = "8"
Case "Sep"
ConvLetterMonthToIntMonth = "9"
Case "Oct"
ConvLetterMonthToIntMonth = "10"
Case "Nov"
ConvLetterMonthToIntMonth = "11"
Case "Dec"
ConvLetterMonthToIntMonth = "12"
End Select
End Function
Sub ShowLogin()
frmLogin.Show
End Sub
' get the value from cell for a given address
Function readCell(sheet_name as string, cell_addr As String)
readCell = Worksheets(sheet_name).Range(cell_addr).Value
End Function
Sub initAccountFromAccountSheet()
Dim i As Integer
Dim account_ws As Worksheet
Set account_ws = Worksheets("account")
i = 0
For i = 1 To 99
Var.usernames(i) = readCell("account", "A" & CStr(i + 1))
Var.passwords(i) = readCell("account", "B" & CStr(i + 1))
Var.teams(i) = readCell("account", "C" & CStr(i + 1))
Var.ages(i) = readCell("account", "D" & CStr(i + 1))
Next i
End Sub