commit ec2b843e116b1f28600d2f3f75c2c55447b75ed5
parent eb97a0eb5088fe1192a737243be809285ed40546
Author: Bharatvaj Hemanth <bharatvaj@yahoo.com>
Date: Sat, 24 Aug 2024 23:33:36 +0530
Completed pending report generation
Completed SBC list generation
Automation 100%
Diffstat:
4 files changed, 742 insertions(+), 412 deletions(-)
diff --git a/Standard/Bharatgas.xba b/Standard/Bharatgas.xba
@@ -1,410 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
-<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Bharatgas" script:language="StarBasic">REM ***** BASIC *****
-'Option VBASupport 1
-Option Explicit
-
-Global Const exportFolder = "C:\Users\bhara\tSync\Pending-01-07-2024"
-Global Const rowsToSkip = 1
-Global Const insertNewRowFor = False
-Global Const printOnlySummary = False
-Global Const roughHeaderMatch = True
-Global Const highlightBasedOn = "Payment Option"
-Global Const highlightSearchString = "Online Payment"
-Global Const highlightRemoveColumn = True
-' TODO change suffix based on the report type
-Global Const sheetNameSuffix = "- PENDING"
-Global Const shouldExportPDF = True
-Global Const isPendingReport = True
-
-Function UsedRangeCursor(Optional ByRef oSheet as Object) as Object
- 'FIXME Check if the split has already happen
- Dim cursor as Object
- if IsNull(oSheet) Or IsMissing(oSheet) Then
- oSheet = ThisComponent.getCurrentController().getActiveSheet()
- End If
- cursor = oSheet.createCursor()
- cursor.gotoStartOfUsedArea(False)
- cursor.gotoEndOfUsedArea(True)
- UsedRangeCursor = cursor
-End Function
-
-Function UserFriendlyName(str as String) as String
- Dim l as Long
- Dim c as String
- Dim i as Long
- Dim prevChar as String
- str = Trim(str)
- ' Check if Len(str) is really called multiple times
- l = Len(str)
- For i = 0 To l
- c = Mid(str, i + 1, 1)
- If i > 1 And (c > "A" And c < "Z") Then
- ' Only prepend space if 'c' is not the first character...
- ' or previous char doesn't have space
- UserFriendlyName = UserFriendlyName & IIf(prevChar = " ", "", " ") & c
- Else
- UserFriendlyName = UserFriendlyName & c
- End If
- prevChar = c
- Next
-End Function
-
-Sub TestFn()
- MsgBox UserFriendlyName("Area Name")
- MsgBox UserFriendlyName("AreaName")
- MsgBox UserFriendlyName(" AreaName")
-End Sub
-
-Sub SortAreaName(Optional oSheet As Variant, Optional cursor as Variant)
- Dim oRange as Object
- Dim oSortFields(1) as new com.sun.star.util.SortField
- Dim oSortDesc(0) as new com.sun.star.beans.PropertyValue
- Dim endRow as Integer
- Dim endColumn as Integer
-
- If IsMissing(oSheet) Then
- oSheet = ThisComponent.Sheets(0)
- cursor = UsedRangeCursor(oSheet)
- End If
-
- endRow = cursor.RangeAddress.EndRow
- endColumn = cursor.RangeAddress.EndColumn
-
- oRange = oSheet.getCellRangeByPosition(0, 1, endColumn, endRow)
- ThisComponent.getCurrentController.select(oRange)
-
- ' Area
- oSortFields(0).Field = 0
- oSortFields(0).SortAscending = True
-
- ' FIXME This is not working
- ' Date
- oSortFields(1).Field = 4
- oSortFields(1).SortAscending = True
-
- oSortDesc(0).Name = "SortFields"
- oSortDesc(0).Value = oSortFields
-
- oRange.Sort(oSortDesc)
-End Sub
-
-Sub NewSheet(sheetName as String)
- Dim sheets as Object
- sheets = ThisComponent.Sheets()
- If Not sheets.hasByName(sheetName) Then
- sheets.insertNewByName(sheetName, sheets.getCount())
- End If
-
-End Sub
-
-Sub CleanColumnHeaders(oSheet as Object, endColumn as Integer)
- Dim cell as Object
- Dim neatName as String
- Dim i as Integer
- For i = 0 To endColumn
- cell = oSheet.getCellByPosition(i, 0)
- neatName = cell.getString()
- neatName = UserFriendlyName(neatName)
- cell.setString(neatName)
- Next
-End Sub
-
-Sub RemoveExtraMergeCells(oSheet as Object, oRangeAddress as Variant)
- Dim oRange as Object
- Dim oSortFields(0) as new com.sun.star.util.SortField
- Dim oSortDesc(0) as new com.sun.star.beans.PropertyValue
- Dim endRow as Integer
-
- endRow = oRangeAddress.EndRow
- lastColumn = oRangeAddress.EndColumn
-
- rem set the range on which to sort'
-
- 'oRange = oSheet.getCellRangeByName("A2:F20")
- oRange = oSheet.getCellRangeByPosition(0, 0, lastColumn, 0)
- ThisComponent.getCurrentController.select(oRange)
- initialColumnCount = oRange.Columns.getCount() - 1
- deletedColumns = 0
- For j = 0 To (initialColumnCount - deletedColumns)
- oCell = oRange.getCellByPosition(j, 0)
- con = oCell.String
- If con = "" Then
- oRange.Columns.removeByIndex(j, 1)
- deletedColumns = deletedColumns - 1
- Else
- Print con
- End If
- Next
-End Sub
-
-
-Sub UnFreezeSelection
- Dim document as Object
- Dim dispatcher as Object
- document = ThisComponent.CurrentController.Frame
- dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
- dispatcher.executeDispatch(document, ".uno:FreezePanes", "", 0, Array())
-End Sub
-
-Function GetHeaderPosition(ByRef oSheet as Object, searchString as String, endColumn as Long) as Integer
- Dim iColumn as Integer
- Dim oCell as Object
- Dim cellString as String
- GetHeaderPosition = -1
- If roughHeaderMatch Then
- searchString = UserFriendlyName(searchString)
- End If
- For iColumn = 0 To endColumn - 1
- oCell = oSheet.getCellByPosition(iColumn, 0)
- cellString = oCell.String
- If roughHeaderMatch Then
- cellString = UserFriendlyName(cellString)
- End If
- If cellString = searchString Then
- GetHeaderPosition = iColumn
- Exit For
- End If
- Next iColumn
-End Function
-
-Sub HighlightOnline(ByRef oSheet as Object, endColumn as Long, endRow as Long)
- ' Fix false positives when having ONLINE and the content has "Online Payment"
- Dim currentStr as String
- Dim oCell as Object
- Dim oCellRange as Object
- Dim str as String
- Dim iSearchColumn as Long
- Dim i as Integer
-
- ' Search for column position that has highlightBasedOn
- iSearchColumn = GetHeaderPosition(oSheet, highlightBasedOn, endRow)
- If iSearchColumn = -1 Then Exit Sub
- For i = 0 To endRow - 1
- oCell = oSheet.getCellByPosition(iSearchColumn, i)
- If InStr(oCell.getString(), highlightSearchString) > 0 Then
- oCellRange = oSheet.getCellRangeByPosition(0, i, endColumn, i)
- oCellRange.CellBackColor = RGB(255, 255, 0) ' Yellow
- End If
- Next i
-
- If highlightRemoveColumn Then
- oSheet.Columns.removeByIndex(iSearchColumn, 1)
- End If
-End Sub
-
-
-Sub MainNew
- Dim oRange as Object
- Dim oSheet as Object
- Dim oCellStyle as Object
- Dim pageStyle as Object
- Dim oStyle as Object
- oSheet = ThisComponent.Sheets.getByIndex(0)
- 'oRange = oSheet.getCellRangeByPosition(1, 1, 4, 1)
- 'oCellStyle = ThisComponent.StyleFamilies.getByName("CellStyles").getByName("InterHeader")
- 'oRange.CellStyle = "InterHeader"
- pageStyle = ThisComponent.StyleFamilies.getByName("PageStyles")
- oStyle = pageStyle.getByName("Default")
- oStyle.CenterVertically = True
- pageStyle.insertByName("NewStyle")
-
- if NOT IsNull(pageStyle) then
- Print pageStyle.dbg_methods
- end if
-
-End Sub
-
-Sub Main
- Dim s as Object
- Dim cursor as Object
- Dim c as Integer
- Dim destSheet as Variant
- Dim sheetName as String
- Dim iArea as Long
- Dim d as String
- Dim a as String
- Dim startRow as Long
- Dim areaNames as New Collection
- Dim dColumns as Object
- Dim endRow as Long
- Dim endColumn as Long
- Dim areaColumn as Object
- Dim areaRange, idRange, bookRange
- Dim headerRange as Object
- Dim cellRangeToCopy as Object
- Dim pageStyle as Object
-
- s = ThisComponent.Sheets(0)
- cursor = UsedRangeCursor(s)
-
- ' Skip Header
- startRow = rowsToSkip
- endRow = cursor.RangeAddress.EndRow
- endColumn = cursor.RangeAddress.EndColumn
-
- ' TODO pass the column name/index as an argument
- ' Transformations to be applied to the Main sheet before splitting the sheet by Area Name
- 'Call UnFreezeSelection
- cursor = UsedRangeCursor(s)
- If isPendingReport Then
- Call HighlightOnline(s, endColumn, endRow)
- End If
- Call SortAreaName(s, cursor)
- Call CleanColumnHeaders(s, endColumn)
-
- ' Justify Leftmost cells to left and Rightmost cells to right
- ' TODO Maybe use more descriptive code? Like ("AreaName")?
- idRange = s.getCellRangeByPosition(1,startRow, 1, endRow)
- idRange.setPropertyValue("HoriJustify", com.sun.star.table.CellHoriJustify.LEFT)
-
- bookRange = s.getCellRangeByPosition(endColumn, startRow, endColumn, endRow)
- bookRange.setPropertyValue("HoriJustify", com.sun.star.table.CellHoriJustify.RIGHT)
-
- areaColumn = s.getCellRangeByPosition(0,startRow, 0, endRow)
- headerRange = s.getCellRangeByPosition(0, 0, endColumn, 0)
-
- headerRange.CellStyle = "Heading 1"
-
- 'On Error Goto ErrorHandler
- For iArea = rowsToSkip To endRow - 1
- d = areaColumn.getCellByPosition(0, iArea).String
- If d = "" Then
- Exit For
- End If
-
- If a <> d Or iArea = (endRow - 1) Then
- ' FIXME Get the columns automatically from the sheet
- ' FIXME Covert the end column from endColumn above
-
- If insertNewRowFor Then
- ' FIXME This is a stub, not correct
- s.Rows.insertByIndex(startRow, 1)
- startRow = startRow + 1
- endRow = endRow + 1
- End If
-
- areaRange = s.getCellRangeByPosition(0, startRow, endColumn, iArea)
- If printOnlySummary Then
- ' TODO maybe there is an elegant way than
- ' writing this two times
- If shouldExportPDF Then
- ExportPDF(destSheet)
- End If
- GoTo Continue
- End If
-
- ' TODO subtotals might solve this
- 's.group(areaRange.RangeAddress, 1)
-
- sheetName = a & sheetNameSuffix
-
- ' Copy the Headers from the Main Document
- ' FIXME This DOES NOT work when using with filtered data
- ' TODO Get the number of columns to copy dynamically from the Sheet.
- cellRangeToCopy = areaRange.RangeAddress
-
- If (cellRangeToCopy.EndRow - cellRangeToCopy.StartRow) = 0 Then
- Goto Continue
- End If
-
- ' Prepare Destination sheet
- NewSheet(sheetName)
-
- destSheet = ThisComponent.Sheets().getByName(sheetName)
-
- pageStyle = ThisComponent.StyleFamilies.getByName("PageStyles").getByName("Default")
- pageStyle.setPropertyValue("PrintGrid", True)
- pageStyle.setPropertyValue("CenterHorizontally", True)
- ' Make the margins 0.2" thick
- pageStyle.setPropertyValue("LeftMargin", 0.2 * 2540)
- pageStyle.setPropertyValue("RightMargin", 0.2 * 2540)
-
- ' Customize the Destination Sheet's Columns
- ' TODO Make snuggly calculation. There should be a minimum width and AutoFit
- With destSheet.getColumns()
- If isPendingReport Then
- .getByName("B").Width = 2500
- .getByName("C").Width = 8000
- .getByName("D").Width = 2500
- Else
- .getByName("B").Width = 1700
- .getByName("C").Width = 5000
- .getByName("D").Width = 11000
- .getByName("E").Width = 2200
- End If
- End With
-
-
- ' Copy Header
- ' TODO Check if it's possible to use UsedRange instead of endColumn
- s.copyRange(destSheet.getCellRangeByName("A1").CellAddress, _
- headerRange.RangeAddress)
-
- ' Copy all the contents uptil
- s.copyRange(destSheet.getCellRangeByName("A2").CellAddress, _
- cellRangeToCopy)
-
- 'TODO Remove Columns that should be deleted in leaveColumns
- ' Better leave it when copying above
- destSheet.getColumns().removeByIndex(0, 1)
- destSheet.getColumns().removeByIndex(4, 1)
-
-
- 'TODO Maybe use Dispatcher?
- If shouldExportPDF Then
- ExportPDF(destSheet)
- End If
- Continue:
- startRow = (iArea + 1)
- a = d
- End If
- Next iArea
-
- ErrorHandler:
- MsgBox "Error#: " & Erl & Error
- 'MsgBox "arrCount: " & areaNames.Count
- MsgBox "a: " & a & ", d: " & d
- Reset
-End Sub
-
-Sub ValidateFileName(fileName as String)
- Dim invalidChars as String : invalidChars = "\/:*?""<>|"
-
- For i = 1 To Len(fileName)
- c = Mid(fileName, i, 1)
- If InStr(invalidChars, c) > 0 Then
- Print "invalid" & c
- End If
- Next
-End Sub
-
-Sub ExportPDF(Optional ByVal oSheet as Object)
- 'Exit Sub
- Dim cursor as Object
- Dim args(2) as New com.sun.star.beans.PropertyValue
- Dim fd(2) as New com.sun.star.beans.PropertyValue
-
- Dim fileName as String
- Dim fileUrl As String
-
- cursor = UsedRangeCursor(oSheet)
-
- 'ThisComponent.CurrentController.select(cursor)
- fileName = exportFolder & "\" & oSheet.Name & ".pdf"
- fileUrl = ConvertToUrl(fileName)
-
- With args(0) : .Name = "FilterName" : .Value = "calc_pdf_Export" : End With
- WIth fd(0) : .Name = "Selection" : .Value = cursor : End With
-
- ' conflicts with the Selection
- With fd(1) : .Name = "SinglePageSheets" : .Value = False : End With
- With fd(2) : .Name = "IsSkipEmptyPages" : .Value = True : End With
-
- With args(1) : .Name = "FilterData" : .Value = fd : End With
- With args(2) : .Name = "Overwrite" : .Value = True : End With
-
- ThisComponent.storeToURL(fileUrl, args)
-End Sub
-
-</script:module>
-\ No newline at end of file
diff --git a/Standard/CylinderAutomation.xba b/Standard/CylinderAutomation.xba
@@ -0,0 +1,266 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
+<script:module xmlns:script="http://openoffice.org/2000/script" script:name="CylinderAutomation" script:language="StarBasic">REM ***** BASIC *****
+'Option VBASupport 1
+Option Explicit
+
+Global Const rowsToSkip = 1
+Global Const roughHeaderMatch = True
+Global Const highlightBasedOn = "Payment Option" ' A yellow background is drawn that matches this column and 'highlightSearchString'
+Global Const highlightSearchString = "Online" ' Does partial match
+Global Const highlightRemoveColumn = True ' True if you want remove the column once the highlight is done
+Global Const reportType = "PENDING" ' Allowed values are "PENDING", "SAFETY" and "SBC". The number of columns that are copied and the column size will be affected
+Global Const shouldExportPDF = True ' If True this will export all the created sheets with Area specific data individually TODO change name to easily understand
+Global Const badDayThreshold = 4 ' The days below 'the maximum date in report' to show as bad
+Global Const shouldSegregateAreaWise = True' True if you want to create sheets with Area specific data
+Global Const exportFolderPrefix = "C:\Users\bhara\Sync\"
+
+' Values are loaded from the document
+Private tillDate as Date
+Private tillDateStr as String
+Private sheetNameSuffix as String
+Private exportFolder as String
+
+'Private shouldExportSummaryPDF as Boolean' If True the first page will be exported as PDF
+
+Sub Main
+ Dim oDoc : oDoc = ThisComponent
+ Dim s as Object
+ Dim cursor as Object
+ Dim c as Integer
+ Dim destSheet as Variant
+ Dim sheetName$, d$, a$
+ Dim areaColumn%, areaNames as New Collection
+ Dim startColumn%, startRow%, endColumn%, endRow%
+ Dim rowsToRemove%, iArea%
+ Dim areaRange, idRange, bookRange
+ Dim dColumns as Object
+ Dim headerRange as Object
+ Dim cellRangeToCopy as Object
+ Dim pageStyle as Object
+ Dim oCellStyles
+ Dim oConFormat
+ Dim oCondition(2) as new com.sun.star.beans.PropertyValue
+ Dim T4Style
+
+ ' Initialize Globals
+ ' Casting to Long removes the time component
+ tillDate = CLng(Now())
+
+ s = oDoc.Sheets(0)
+ cursor = UsedRangeCursor(s)
+
+ ' NaiveLastTable gives us the last non-blank table's
+ rowsToRemove = NaiveLastTable(s)
+ If rowsToRemove <> 0 Then
+ s.getRows().removeByIndex(0, rowsToRemove + 1)
+ End If
+
+ startRow = 1
+ startColumn = 0
+ endRow = cursor.RangeAddress.EndRow
+ endColumn = cursor.RangeAddress.EndColumn
+
+ ' TODO move this to knowledge base
+ oCellStyles = ThisComponent.StyleFamilies("CellStyles")
+ If Not oCellStyles.hasByName("T4") Then
+ T4Style = oDoc.createInstance("com.sun.star.style.CellStyle")
+ oCellStyles.insertByName("T4", T4Style)
+ oCellStyles.getByName("T4").CellBackColor = RGB(255, 0, 0)
+ End If
+
+ If ThisComponent.CurrentController.hasFrozenPanes() Then
+ Call UnFreezeSelection
+ End If
+
+ ' TODO pass the column name/index as an argument
+ ' Transformations to be applied to the Main sheet before splitting the sheet by Area Name
+ cursor = UsedRangeCursor(s)
+
+ Call CleanColumnHeaders(s, endColumn)
+
+ areaColumn = GetHeaderPosition(s, endColumn, "Area")
+ Call ShortenDirections(s, areaColumn)
+
+ If Left(reportType, 1) = "P" Then
+ Call ApplyTheme "millennium.ots"
+ endColumn = RemoveColumnsExcept(s, endColumn, Array( _
+ "Area", _
+ "ID", _
+ "Name", _
+ "Mobile", _
+ "Book", _
+ "Payment Option" _
+ ))
+
+ endColumn = HighlightRowWithColumn(s, endColumn, endRow, _
+ "Payment Option", "Online Payment", True, _
+ RGB(255, 255, 0))
+
+ ' Justify Leftmost cells to left and Rightmost cells to right
+
+ bookRange = GetColumnRange(s, endColumn, endRow, "Book")
+ bookRange.setPropertyValue("HoriJustify", com.sun.star.table.CellHoriJustify.RIGHT)
+
+ FormatRangeAsNumber(s, new com.sun.star.lang.Locale, oDoc.getNumberFormats(), bookRange, "DD/MM")
+
+ tillDate = FindHighestDateAsString(s, "Book", endColumn, endRow)
+
+ With oCondition(0) : .Name = "Operator" : .Value = com.sun.star.sheet.ConditionOperator.LESS_EQUAL : End With
+ oCondition(1).Name = "Formula1" : oCondition(1).Value = CLng(tillDate - badDayThreshold)
+ With oCondition(2) : .Name = "StyleName" : .Value = "T4" : End With
+ oConFormat = bookRange.ConditionalFormat
+ oConFormat.clear() : oConFormat.addNew(oCondition)
+
+ SetWidths(s, endColumn, Array( _
+ Array("Area", 0), _
+ Array("ID", 0), _
+ Array("Name", 7000), _
+ Array("Mobile", 0), _
+ Array("Book", 0) _
+ ))
+ ElseIf reportType = "SBC" Then
+ Call ApplyTheme "pumpkin.ots"
+ endColumn = RemoveColumnsExcept(s, endColumn, Array( _
+ "ID", _
+ "Name", _
+ "Address", _
+ "Mobile", _
+ "Area", _
+ "No Of Cylinder" _
+ ))
+ SetWidths(s, endColumn, Array( _
+ Array("ID", 0), _
+ Array("Name", 3000), _
+ Array("Address", 8000), _
+ Array("Mobile", 0), _
+ Array("Area", 0) _
+ ))
+ End If
+
+ idRange = GetColumnRange(s , endColumn, endRow, "ID") _
+ .setPropertyValue("HoriJustify", com.sun.star.table.CellHoriJustify.LEFT)
+
+ Call SortColumn(s, endColumn, endRow, "Area")
+
+ ' Setup exportFolder and sheetName
+ tillDateStr = Replace(CDate(tillDate), "/", "-")
+ tillDateStr = Trim(tillDateStr)
+ sheetNameSuffix = " - " & reportType & " " & tillDateStr
+ exportFolder = exportFolderPrefix & "/" & reportType & " " & tillDateStr
+
+ headerRange = s.getCellRangeByPosition(0, 0, endColumn, 0)
+ headerRange.CellStyle = "Heading 1"
+
+ pageStyle = ThisComponent.StyleFamilies.getByName("PageStyles").getByName("Default")
+ pageStyle.setPropertyValue("PrintGrid", True)
+ pageStyle.setPropertyValue("CenterHorizontally", True)
+ ' Make the margins 0.2" thick
+
+ pageStyle.setPropertyValue("LeftMargin", 0.2 * 2540)
+ pageStyle.setPropertyValue("RightMargin", 0.2 * 2540)
+
+ ' Change original sheet name
+ s.Name = "SUMMARY" & sheetNameSuffix
+
+ ' Export summary
+ If shouldExportPDF Then
+ ExportPDF(s, exportFolder)
+ End If
+
+ If NOT shouldSegregateAreaWise Then Exit Sub
+
+ Dim statusBar
+ statusBar = oDoc.CurrentController.StatusIndicator
+ statusBar.start("Creating Area Wise", 10)
+
+ areaRange = s.getCellRangeByPosition(areaColumn, startRow, areaColumn, endRow)
+ a = areaRange.getCellByPosition(0, startRow).getString()
+ 'On Error Goto ErrorHandler
+ For iArea = startRow To endRow - 1
+ d = areaRange.getCellByPosition(0, iArea).getString()
+ If d = "" Then
+ Exit For
+ End If
+
+ If a <> d Or iArea = (endRow - 1) Then
+ statusBar.setValue((iArea / endRow) * 100)
+ ' FIXME Get the columns automatically from the sheet
+ ' FIXME Covert the end column from endColumn above
+
+ Goto Con:
+ Dim cName
+ s.Rows.insertByIndex(startRow, 1)
+ cName = s.getCellByPosition(startColumn, startRow)
+ cName.setString(d)
+ startRow = startRow + 1
+ endRow = endRow + 1
+
+ Con:
+ ' TODO maybe there is an elegant way than
+ ' writing this two times
+ sheetName = a & sheetNameSuffix
+
+ ' TODO subtotals might solve this
+ 's.group(areaRange.RangeAddress, 1)
+
+ ' Prepare Destination sheet
+ destSheet = NewSheet(sheetName)
+
+
+ ' Copy the Headers from the Main Document
+ If areaColumn > 0 And areaColumn < endColumn Then
+ MsgBox "Can't have Area column in the middle", 16
+ Exit Sub
+ End If
+
+ ' start end
+ '1 : endColumn 0 4
+ 'areaColumn + 1 : endColumn 2 4
+ '0 : endColumn - 1 4 4
+
+ ' Copy Header
+ s.copyRange(destSheet.getCellRangeByName("A1").CellAddress, _
+ s.getCellRangeByPosition( _
+ (endColumn - areaColumn)/ endColumn, _
+ 0, endcolumn - CInt(areaColumn/endColumn), 0).RangeAddress)
+
+ ' Copy Contents
+ s.copyRange(destSheet.getCellRangeByName("A2").CellAddress, _
+ s.getCellRangeByPosition(_
+ (endColumn - areaColumn)/ endColumn, _
+ startRow, _
+ endcolumn - CInt(areaColumn/endColumn), _
+ iArea).RangeAddress)
+
+ ' Customize the Destination Sheet's Columns
+ If Left(reportType, 1) = "P" Then
+ SetWidths(destSheet, endColumn, Array( _
+ Array("ID", 0), _
+ Array("Name", 7000), _
+ Array("Mobile", 0), _
+ Array("Book", 0) _
+ ))
+ ElseIf reportType = "SBC" Then
+ SetWidths(destSheet, endColumn, Array( _
+ Array("ID", 0), _
+ Array("Name", 4000), _
+ Array("Address", 11000), _
+ Array("Mobile", 0) _
+ ))
+ End If
+
+ If shouldExportPDF Then
+ ExportPDF(destSheet, exportFolder)
+ End If
+ Continue:
+ startRow = (iArea + 1)
+ a = d
+ End If
+ Next iArea
+
+ ErrorHandler:
+ statusBar.end()
+ Reset
+End Sub
+</script:module>
+\ No newline at end of file
diff --git a/Standard/HandyTools.xba b/Standard/HandyTools.xba
@@ -0,0 +1,472 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
+<script:module xmlns:script="http://openoffice.org/2000/script" script:name="HandyTools" script:language="StarBasic" script:moduleType="normal">REM ***** BASIC *****
+Option Explicit
+
+Function GetFriendlyWords() as Variant
+ GetFriendlyWords = Array( _
+ "AreaCodeDesc", "Area", _
+ "AreaDescription", "Area", _
+ "ConsumerNumber", "ID", _
+ "ConsumerName", "Name", _
+ "MobileNumber", "Mobile", _
+ "BookDate", "Book"_
+ )
+ If (UBound(GetFriendlyWords) Mod 2) <> 1 Then
+ Print "Mismatch in friendlyWords array"
+ Exit Function
+ End If
+End Function
+
+Sub FormatRangeAsNumber(oSheet, oLocale, ByRef oFormats, oRange, formatStr as String)
+ ' BASIC equivalent of 'Text to Columns'
+ Dim formatNum as Long, i as Integer
+ Dim oReplace
+ oReplace = oRange.createReplaceDescriptor()
+
+ If oRange.getCellByPosition(0,0).getValue() = 0 Then
+ formatNum = oFormats.queryKey(formatStr, oLocale, False)
+ ' add formatStr if it doesn't exist
+ If formatNum = -1 Then
+ formatNum = oFormats.addNew(formatStr, oLocale)
+ If formatNum = -1 Then
+ MsgBox "Cannot add " & formatStr & " as NumberFormat", 0, "Fatal"
+ Exit Sub
+ End If
+ End If
+
+ With oReplace
+ .searchString = ".+"
+ .replaceString = "&"
+ .SearchRegularExpression = True
+ End With
+
+ oRange.NumberFormat = formatNum
+ oRange.replaceAll(oReplace)
+ End If
+End Sub
+
+Function GetColumnRange(oSheet, endColumn as Long, endRow as Long, searchString as String) as Object
+ Dim iHeaderPos
+ 'GetColumn = -1
+ iHeaderPos = GetHeaderPosition(oSheet, endColumn, searchString)
+ If iHeaderPos = -1 Then
+ Exit Function
+ End If
+ GetColumnRange = oSheet.getCellRangeByPosition(iHeaderPos, 1, iHeaderPos, endRow)
+End Function
+
+Function RemoveColumns(oSheet, endColumn as Integer, columnNames) as Long
+ Dim columnName as String
+ Dim iHeader as Integer
+ RemoveColumns = endColumn
+ For Each columnName in columnNames
+ iHeader = GetHeaderPosition(oSheet, endColumn, columnName)
+ If iHeader <> -1 Then
+ oSheet.getColumns().removeByIndex(iHeader, 1)
+ endColumn = endColumn - 1
+ End If
+ Next
+ RemoveColumns = endColumn
+End Function
+
+Function RemoveColumnsExcept(oSheet as Object, endColumn as Integer, columnNames as Variant) as Long
+ Dim headerStr as String, columnName as String
+ Dim i% : i = 0
+ Dim rI% : rI = 0
+ Dim columnsToRemove(endColumn) as String
+ Dim headerRange, headerData
+ Dim found as Boolean : found = False
+ RemoveColumnsExcept = endColumn
+
+ headerRange = oSheet.getCellRangeByPosition(0, 0, endColumn, 0)
+ headerData = headerRange.getFormulaArray()
+
+ ' TODO Handle condition when columnNames does not have valid header
+ ' This causes an extra string element in the array
+ For i = 0 To UBound(headerData(0))
+ headerStr = headerData(0)(i)
+ found = False
+ For Each columnName in columnNames
+ If headerStr = columnName Then
+ found = True
+ Exit For
+ End If
+ Next columnName
+ If Not found Then
+ columnsToRemove(rI) = headerStr
+ rI = rI + 1
+ End If
+ Next i
+
+ If i = 0 Then
+ Exit Function
+ End If
+
+ ReDim Preserve columnsToRemove(rI - 1)
+
+ RemoveColumnsExcept = RemoveColumns(oSheet, endColumn, columnsToRemove)
+End Function
+
+Sub ApplyTheme(sFileName As String)
+ Dim oFamilies
+ Dim aOptions(0) as New com.sun.star.beans.PropertyValue
+ Dim stylesDir()
+ Dim StylePath as String
+ GlobalScope.BasicLibraries.loadLibrary("Tools")
+ oFamilies = ThisComponent.StyleFamilies
+ StylesDir = GetOfficeSubPath("Template", "wizard/styles/")
+ StylePath = StylesDir & sFileName
+ aOptions(0).Name = "OverwriteStyles"
+ aOptions(0).Value = true
+ oFamilies.loadStylesFromURL(StylePath, aOptions())
+End Sub
+
+Function NaiveLastTable(oSheet) as Long
+ ' Return the row position last table that is separated by an empty row
+ Dim oRows
+ Dim iRow as Long
+ Dim usedRange
+ NaiveLastTable = 0
+
+ oRows = UsedRangeCursor(oSheet).Rows
+
+ For iRow = 0 To oRows.getCount() - 1
+ 'Print rows(i).dbg_methods()
+ If oRows.getByIndex(iRow).computeFunction(com.sun.star.sheet.GeneralFunction.COUNT) = 0 Then
+ NaiveLastTable = iRow
+ End If
+ Next
+End Function
+
+Function IsValidFileName(fileName as String) as Boolean
+ Dim invalidChars as String : invalidChars = "\/:*?""<>|"
+ Dim c as String
+ Dim i as Integer
+ IsValidFileName = False
+ For i = 1 To Len(fileName)
+ c = Mid(fileName, i, 1)
+ If InStr(invalidChars, c) > 0 Then
+ Print "Invalid character '" & c & "' found in '" & fileName & "'"
+ Exit Function
+ End If
+ Next
+ IsValidFileName = True
+End Function
+
+Sub ExportPDF(oSheet, exportFolder as String)
+ Dim cursor as Object
+ Dim args(2) as New com.sun.star.beans.PropertyValue
+ Dim fd(2) as New com.sun.star.beans.PropertyValue
+ Dim fileName as String
+
+ If Not IsValidFileName(oSheet.Name) Then
+ Exit Sub
+ End If
+
+ fileName = exportFolder & "/" & oSheet.Name & ".pdf"
+
+ WIth fd(0) : .Name = "Selection" : .Value = UsedRangeCursor(oSheet) : End With
+ ' Disabled, because it conflicts with selection
+ With fd(1) : .Name = "SinglePageSheets" : .Value = False : End With
+ With fd(2) : .Name = "IsSkipEmptyPages" : .Value = True : End With
+
+ With args(0) : .Name = "FilterName" : .Value = "calc_pdf_Export" : End With
+ With args(1) : .Name = "FilterData" : .Value = fd : End With
+ With args(2) : .Name = "Overwrite" : .Value = True : End With
+
+ ThisComponent.storeToURL(ConvertToUrl(fileName), args)
+End Sub
+
+
+Sub ListOfActiveCustomers()
+ Dim oSheet, destSheet, cursor, oRange
+ Dim startRow as Long
+ Dim endRow as Long
+ Dim startColumn as Long
+ Dim endColumn as Long
+ Dim requiredFields()
+ Dim requiredFieldIndices() as Integer
+ Dim iColumn as Integer, iRequiredField as Integer
+ Dim headerCellStr as String
+
+ oSheet = ThisComponent.Sheets(0)
+ cursor = UsedRangeCursor(oSheet)
+
+ ' Skip Header
+ startRow = NaiveLastTable(ThisComponent, cursor)
+ endRow = cursor.RangeAddress.EndRow
+ endColumn = cursor.RangeAddress.EndColumn
+ ' TODO Use data from PhoneNumber if some MobileNumber is missing
+ requiredFields = Array("ConsumerNumber", "ConsumerName", "MobileNumber", "AreaCodeDesc", "LastDelivDate")
+ 'oSheet.Rows.removeByIndex(0, 3)
+
+ For iColumn = startColumn To endColumn
+ headerCellStr = oSheet.getCellByPosition(iColumn, startRow, iColumn, startRow).getString()
+ For iRequiredField = 0 To UBound(requiredFields)
+ If headerCellStr = requiredFields(iRequiredField) Then
+ ' TODO Allocate memory before hand and use a tracker index?
+ ReDim Preserve requiredFieldIndices(UBound(requiredFieldIndices) + 1)
+ requiredFieldIndices(UBound(requiredFieldIndices)) = iColumn
+ End If
+ Next iRequiredField
+ Next iColumn
+ destSheet = NewSheet("SBC Connection")
+
+ Print Join(requiredFieldIndices)
+
+ ' TODO Ignore the Header Table if it exists
+ ' i.e. If two tables exists, assume the first one to be header table
+ ' and ignore it while copying to new sheet
+
+ ' Copy the cells in 'requiredFieldIndices' to 'destSheet'
+End Sub
+
+
+Function UsedRangeCursor(Optional ByRef oSheet as Object) as Object
+ Dim cursor as Object
+ if IsNull(oSheet) Or IsMissing(oSheet) Then
+ oSheet = ThisComponent.getCurrentController().getActiveSheet()
+ End If
+ cursor = oSheet.createCursor()
+ cursor.gotoStartOfUsedArea(False)
+ cursor.gotoEndOfUsedArea(True)
+ UsedRangeCursor = cursor
+End Function
+
+Function UserFriendlyName(str as String) as String
+ ' Checks headerName and headerNameMatches for the string 'str',
+ ' If it's not available there, a naïve implementation adds spacing to 'str'
+ Dim l as Long
+ Dim c as String
+ Dim i as Long
+ Dim prevChar as String
+ Dim friendlyWords : friendlyWords = GetFriendlyWords()
+ str = Trim(str)
+ ' Check if Len(str) is really called multiple times
+ l = Len(str)
+ ' Check with header "database"
+
+ For i = 0 To UBound(friendlyWords) Step 2
+ If friendlyWords(i) = str Then
+ UserFriendlyName = friendlyWords(i + 1)
+ Exit Function
+ End If
+ Next i
+
+ For i = 0 To l
+ c = Mid(str, i + 1, 1)
+ If i > 1 And (c > "A" And c < "Z") Then
+ ' Only prepend space if 'c' is not the first character...
+ ' or previous char doesn't have space
+ UserFriendlyName = UserFriendlyName & IIf(prevChar = " ", "", " ") & c
+ Else
+ UserFriendlyName = UserFriendlyName & c
+ End If
+ prevChar = c
+ Next
+End Function
+
+Sub SortColumn(oSheet As Variant, endColumn as Integer, endRow as Integer, columnName as String)
+ Dim oRange as Object
+ Dim iHeaderPos as Integer
+ Dim oSortFields(1) as new com.sun.star.util.SortField
+ Dim oSortDesc(0) as new com.sun.star.beans.PropertyValue
+
+ oRange = oSheet.getCellRangeByPosition(0, 1, endColumn, endRow)
+ ThisComponent.getCurrentController.select(oRange)
+
+ iHeaderPos = GetHeaderPosition(oSheet, endColumn, columnName)
+ If iHeaderPos = -1 Then
+ Exit Sub
+ End If
+ ' Area
+ oSortFields(0).Field = iHeaderPos
+ oSortFields(0).SortAscending = True
+
+ ' TODO Enable this later
+ ' Date
+ 'oSortFields(1).Field = 4
+ 'oSortFields(1).SortAscending = True
+
+ oSortDesc(0).Name = "SortFields"
+ oSortDesc(0).Value = oSortFields
+
+ oRange.Sort(oSortDesc)
+End Sub
+
+Function NewSheet(sheetName as String) as Object
+ Dim sheets as Object
+ sheets = ThisComponent.Sheets()
+ If Not sheets.hasByName(sheetName) Then
+ sheets.insertNewByName(sheetName, sheets.getCount())
+ End If
+ NewSheet = sheets.getByName(sheetName)
+End Function
+
+Sub CleanColumnHeaders(oSheet as Object, endColumn as Integer)
+ Dim cell as Object
+ Dim neatName as String
+ Dim i as Integer
+ For i = 0 To endColumn
+ cell = oSheet.getCellByPosition(i, 0)
+ neatName = cell.getString()
+ neatName = UserFriendlyName(neatName)
+ cell.setString(neatName)
+ Next
+End Sub
+
+Sub RemoveExtraMergeCells(oSheet as Object, oRangeAddress as Variant)
+ Dim oRange as Object
+ Dim oSortFields(0) as new com.sun.star.util.SortField
+ Dim oSortDesc(0) as new com.sun.star.beans.PropertyValue
+ Dim endRow as Integer
+
+ endRow = oRangeAddress.EndRow
+ lastColumn = oRangeAddress.EndColumn
+
+ rem set the range on which to sort'
+
+ 'oRange = oSheet.getCellRangeByName("A2:F20")
+ oRange = oSheet.getCellRangeByPosition(0, 0, lastColumn, 0)
+ ThisComponent.getCurrentController.select(oRange)
+ initialColumnCount = oRange.Columns.getCount() - 1
+ deletedColumns = 0
+ For j = 0 To (initialColumnCount - deletedColumns)
+ oCell = oRange.getCellByPosition(j, 0)
+ con = oCell.String
+ If con = "" Then
+ oRange.Columns.removeByIndex(j, 1)
+ deletedColumns = deletedColumns - 1
+ Else
+ Print con
+ End If
+ Next
+End Sub
+
+
+Sub UnFreezeSelection
+ Dim document as Object
+ Dim dispatcher as Object
+ document = ThisComponent.CurrentController.Frame
+ dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
+ dispatcher.executeDispatch(document, ".uno:FreezePanes", "", 0, Array())
+End Sub
+
+Function GetHeaderPosition(ByRef oSheet as Object, endColumn as Integer, searchString as String) as Integer
+ Dim iColumn as Integer
+ Dim oCell as Object
+ Dim cellString as String
+ GetHeaderPosition = -1
+ If searchString = "" Then
+ Exit Function
+ End If
+ If roughHeaderMatch Then
+ searchString = UserFriendlyName(searchString)
+ End If
+ For iColumn = 0 To endColumn
+ oCell = oSheet.getCellByPosition(iColumn, 0)
+ cellString = oCell.String
+ If cellString = "" Then
+ 'MsgBox "Cannot have empty column, endColumn is " & CStr(endColumn), 16, "Bad argument"
+ Exit Function
+ End If
+ If roughHeaderMatch Then
+ cellString = UserFriendlyName(cellString)
+ End If
+ If cellString = searchString OR Instr(cellString, searchString) = 1 Then
+ GetHeaderPosition = iColumn
+ Exit For
+ End If
+ Next iColumn
+End Function
+
+Function HighlightRowWithColumn(ByRef oSheet as Object, endColumn as Long, endRow as Long, highlightColumnName, highlightValue, removeColumn as Boolean, Optional highlightColor as Long) as Long
+ Dim currentStr as String
+ Dim oCell as Object
+ Dim oCellRange as Object
+ Dim str as String
+ Dim iSearchColumn as Long
+ Dim i as Integer
+ HighlightRowWithColumn = endColumn
+
+
+ ' Search for column position that has highlightBasedOn
+ iSearchColumn = GetHeaderPosition(oSheet, endColumn, highlightColumnName)
+ If iSearchColumn = -1 Then Exit Function
+ For i = 0 To endRow - 1
+ oCell = oSheet.getCellByPosition(iSearchColumn, i)
+ If InStr(oCell.getString(), highlightValue) > 0 Then
+ oCellRange = oSheet.getCellRangeByPosition(0, i, endColumn, i)
+ oCellRange.CellBackColor = highlightColor
+ End If
+ Next i
+
+ If removeColumn Then
+ oSheet.Columns.removeByIndex(iSearchColumn, 1)
+ endColumn = endColumn - 1
+ End If
+End Function
+
+Function FindHighestDateAsString(oSheet as Object, columnName as String, endColumn as Integer, endRow as Integer) as Date
+ Dim dateHeaderPos
+ Dim dateColumn
+ Dim dateVal
+ dateHeaderPos = GetHeaderPosition(oSheet, endColumn, columnName)
+ If dateHeaderPos = -1 Then
+ MsgBox "Cannot find a column header that starts with '" & columnName & "'", 0, "Bad column name"
+ Exit Function
+ End If
+ ' TODO Check if the column we are searching, actually has date values.
+ dateColumn = oSheet.getCellRangeByPosition(dateHeaderPos, 1, dateHeaderPos, endRow)
+ dateVal = dateColumn.computeFunction(com.sun.star.sheet.GeneralFunction.MAX)
+ If dateVal = 0 Then MsgBox "Invalid date found in column '" & columnName & "' - " & dateHeaderPos & "", 16, "Bad date found"
+ FindHighestDateAsString = dateVal
+End Function
+
+' TODO Use a general function that takes arrays
+' and instead of the function ShortenDirections, use
+' ReplaceArrays to make it more usable across other projects.
+Sub ShortenDirections(oSheet as Object, columnIdx as Integer)
+ 'Shorten East as E. etc
+ Dim toReplace() as String
+ Dim toReplaceWith() as String
+ Dim i as Long
+ Dim oDescriptor
+ Dim oColumn
+ Dim columnToReplace
+ oColumn = oSheet.getColumns().getByIndex(columnIdx)
+ ' TODO arrange it with convention
+ toReplace() = Array("East", "West", "South", "North")
+ toReplaceWith() = Array("E.", "W.", "S.", "N.")
+ oDescriptor = oColumn.createReplaceDescriptor()
+ For i = LBound(toReplace) To UBound(toReplace)
+ With oDescriptor
+ .SearchString = toReplace(i)
+ .ReplaceString = toReplaceWIth(i)
+ End With
+ oColumn.replaceAll(oDescriptor)
+ Next i
+End Sub
+
+Sub SetWidths(oSheet, endColumn as Integer, columnWidthArray() as Variant)
+ ' columnWidthArray has values like Array(Array("Area", 0), Array("ID", 2000))
+ ' 0 means autofill
+ Dim i as Integer
+ Dim columnWidth
+ Dim iHeaderColumn
+ For Each columnWidth in columnWidthArray
+ iHeaderColumn = GetHeaderPosition(oSheet, endColumn, columnWidth(0))
+ If iHeaderColumn = -1 Then
+ Print "Cannot find: " & columnWidth(0) & " in headers"
+ Exit Sub
+ End If
+ if columnWidth(1) = 0 Then
+ oSheet.getColumns().getByIndex(iHeaderColumn).OptimalWidth = True
+ Else
+ oSheet.getColumns().getByIndex(iHeaderColumn).Width = columnWidth(1)
+ End If
+ Next
+End Sub
+
+</script:module>
+\ No newline at end of file
diff --git a/Standard/script.xlb b/Standard/script.xlb
@@ -1,5 +1,6 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Standard" library:readonly="false" library:passwordprotected="false">
- <library:element library:name="Bharatgas"/>
+ <library:element library:name="HandyTools"/>
+ <library:element library:name="CylinderAutomation"/>
</library:library>
\ No newline at end of file
