CylinderAutomation.xba (9603B)
1 <?xml version="1.0" encoding="UTF-8"?> 2 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="CylinderAutomation" script:language="StarBasic">REM ***** BASIC ***** 4 'Option VBASupport 1 5 Option Explicit 6 7 Global Const rowsToSkip = 1 8 Global Const roughHeaderMatch = True 9 Global Const highlightBasedOn = "Payment Option" ' A yellow background is drawn that matches this column and 'highlightSearchString' 10 Global Const highlightSearchString = "Online" ' Does partial match 11 Global Const highlightRemoveColumn = True ' True if you want remove the column once the highlight is done 12 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 13 Global Const shouldExportPDF = True ' If True this will export all the created sheets with Area specific data individually TODO change name to easily understand 14 Global Const badDayThreshold = 4 ' The days below 'the maximum date in report' to show as bad 15 Global Const shouldSegregateAreaWise = True' True if you want to create sheets with Area specific data 16 Global Const exportFolderPrefix = "C:\Users\bhara\Sync\" 17 18 ' Values are loaded from the document 19 Private tillDate as Date 20 Private tillDateStr as String 21 Private sheetNameSuffix as String 22 Private exportFolder as String 23 24 'Private shouldExportSummaryPDF as Boolean' If True the first page will be exported as PDF 25 26 Sub Main 27 Dim oDoc : oDoc = ThisComponent 28 Dim s as Object 29 Dim cursor as Object 30 Dim c as Integer 31 Dim destSheet as Variant 32 Dim sheetName$, d$, a$ 33 Dim areaColumn%, areaNames as New Collection 34 Dim startColumn%, startRow%, endColumn%, endRow% 35 Dim rowsToRemove%, iArea% 36 Dim areaRange, idRange, bookRange 37 Dim dColumns as Object 38 Dim headerRange as Object 39 Dim cellRangeToCopy as Object 40 Dim pageStyle as Object 41 Dim oCellStyles 42 Dim oConFormat 43 Dim oCondition(2) as new com.sun.star.beans.PropertyValue 44 Dim T4Style 45 46 ' Initialize Globals 47 ' Casting to Long removes the time component 48 tillDate = CLng(Now()) 49 50 s = oDoc.Sheets(0) 51 cursor = UsedRangeCursor(s) 52 53 ' NaiveLastTable gives us the last non-blank table's 54 rowsToRemove = NaiveLastTable(s) 55 If rowsToRemove <> 0 Then 56 s.getRows().removeByIndex(0, rowsToRemove + 1) 57 End If 58 59 startRow = 1 60 startColumn = 0 61 endRow = cursor.RangeAddress.EndRow 62 endColumn = cursor.RangeAddress.EndColumn 63 64 ' TODO move this to knowledge base 65 oCellStyles = ThisComponent.StyleFamilies("CellStyles") 66 If Not oCellStyles.hasByName("T4") Then 67 T4Style = oDoc.createInstance("com.sun.star.style.CellStyle") 68 oCellStyles.insertByName("T4", T4Style) 69 oCellStyles.getByName("T4").CellBackColor = RGB(255, 0, 0) 70 End If 71 72 If ThisComponent.CurrentController.hasFrozenPanes() Then 73 Call UnFreezeSelection 74 End If 75 76 ' TODO pass the column name/index as an argument 77 ' Transformations to be applied to the Main sheet before splitting the sheet by Area Name 78 cursor = UsedRangeCursor(s) 79 80 Call CleanColumnHeaders(s, endColumn) 81 82 areaColumn = GetHeaderPosition(s, endColumn, "Area") 83 Call ShortenDirections(s, areaColumn) 84 85 If Left(reportType, 1) = "P" Then 86 Call ApplyTheme "millennium.ots" 87 endColumn = RemoveColumnsExcept(s, endColumn, Array( _ 88 "Area", _ 89 "ID", _ 90 "Name", _ 91 "Mobile", _ 92 "Book", _ 93 "Payment Option" _ 94 )) 95 96 endColumn = HighlightRowWithColumn(s, endColumn, endRow, _ 97 "Payment Option", "Online Payment", True, _ 98 RGB(255, 255, 0)) 99 100 ' Justify Leftmost cells to left and Rightmost cells to right 101 102 bookRange = GetColumnRange(s, endColumn, endRow, "Book") 103 bookRange.setPropertyValue("HoriJustify", com.sun.star.table.CellHoriJustify.RIGHT) 104 105 FormatRangeAsNumber(s, new com.sun.star.lang.Locale, oDoc.getNumberFormats(), bookRange, "DD/MM") 106 107 tillDate = FindHighestDateAsString(s, "Book", endColumn, endRow) 108 109 With oCondition(0) : .Name = "Operator" : .Value = com.sun.star.sheet.ConditionOperator.LESS_EQUAL : End With 110 oCondition(1).Name = "Formula1" : oCondition(1).Value = CLng(tillDate - badDayThreshold) 111 With oCondition(2) : .Name = "StyleName" : .Value = "T4" : End With 112 oConFormat = bookRange.ConditionalFormat 113 oConFormat.clear() : oConFormat.addNew(oCondition) 114 115 SetWidths(s, endColumn, Array( _ 116 Array("Area", 0), _ 117 Array("ID", 0), _ 118 Array("Name", 7000), _ 119 Array("Mobile", 0), _ 120 Array("Book", 0) _ 121 )) 122 ElseIf reportType = "SBC" Then 123 Call ApplyTheme "pumpkin.ots" 124 endColumn = RemoveColumnsExcept(s, endColumn, Array( _ 125 "ID", _ 126 "Name", _ 127 "Address", _ 128 "Mobile", _ 129 "Area", _ 130 "No Of Cylinder" _ 131 )) 132 SetWidths(s, endColumn, Array( _ 133 Array("ID", 0), _ 134 Array("Name", 3000), _ 135 Array("Address", 8000), _ 136 Array("Mobile", 0), _ 137 Array("Area", 0) _ 138 )) 139 End If 140 141 idRange = GetColumnRange(s , endColumn, endRow, "ID") _ 142 .setPropertyValue("HoriJustify", com.sun.star.table.CellHoriJustify.LEFT) 143 144 Call SortColumn(s, endColumn, endRow, "Area") 145 146 ' Setup exportFolder and sheetName 147 tillDateStr = Replace(CDate(tillDate), "/", "-") 148 tillDateStr = Trim(tillDateStr) 149 sheetNameSuffix = " - " & reportType & " " & tillDateStr 150 exportFolder = exportFolderPrefix & "/" & reportType & " " & tillDateStr 151 152 headerRange = s.getCellRangeByPosition(0, 0, endColumn, 0) 153 headerRange.CellStyle = "Heading 1" 154 155 pageStyle = ThisComponent.StyleFamilies.getByName("PageStyles").getByName("Default") 156 pageStyle.setPropertyValue("PrintGrid", True) 157 pageStyle.setPropertyValue("CenterHorizontally", True) 158 ' Make the margins 0.2" thick 159 160 pageStyle.setPropertyValue("LeftMargin", 0.2 * 2540) 161 pageStyle.setPropertyValue("RightMargin", 0.2 * 2540) 162 163 ' Change original sheet name 164 s.Name = "SUMMARY" & sheetNameSuffix 165 166 ' Export summary 167 If shouldExportPDF Then 168 ExportPDF(s, exportFolder) 169 End If 170 171 If NOT shouldSegregateAreaWise Then Exit Sub 172 173 Dim statusBar 174 statusBar = oDoc.CurrentController.StatusIndicator 175 statusBar.start("Creating Area Wise", 10) 176 177 areaRange = s.getCellRangeByPosition(areaColumn, startRow, areaColumn, endRow) 178 a = areaRange.getCellByPosition(0, startRow).getString() 179 'On Error Goto ErrorHandler 180 For iArea = startRow To endRow - 1 181 d = areaRange.getCellByPosition(0, iArea).getString() 182 If d = "" Then 183 Exit For 184 End If 185 186 If a <> d Or iArea = (endRow - 1) Then 187 statusBar.setValue((iArea / endRow) * 100) 188 ' FIXME Get the columns automatically from the sheet 189 ' FIXME Covert the end column from endColumn above 190 191 Goto Con: 192 Dim cName 193 s.Rows.insertByIndex(startRow, 1) 194 cName = s.getCellByPosition(startColumn, startRow) 195 cName.setString(d) 196 startRow = startRow + 1 197 endRow = endRow + 1 198 199 Con: 200 ' TODO maybe there is an elegant way than 201 ' writing this two times 202 sheetName = a & sheetNameSuffix 203 204 ' TODO subtotals might solve this 205 's.group(areaRange.RangeAddress, 1) 206 207 ' Prepare Destination sheet 208 destSheet = NewSheet(sheetName) 209 210 211 ' Copy the Headers from the Main Document 212 If areaColumn > 0 And areaColumn < endColumn Then 213 MsgBox "Can't have Area column in the middle", 16 214 Exit Sub 215 End If 216 217 ' start end 218 '1 : endColumn 0 4 219 'areaColumn + 1 : endColumn 2 4 220 '0 : endColumn - 1 4 4 221 222 ' Copy Header 223 s.copyRange(destSheet.getCellRangeByName("A1").CellAddress, _ 224 s.getCellRangeByPosition( _ 225 (endColumn - areaColumn)/ endColumn, _ 226 0, endcolumn - CInt(areaColumn/endColumn), 0).RangeAddress) 227 228 ' Copy Contents 229 s.copyRange(destSheet.getCellRangeByName("A2").CellAddress, _ 230 s.getCellRangeByPosition(_ 231 (endColumn - areaColumn)/ endColumn, _ 232 startRow, _ 233 endcolumn - CInt(areaColumn/endColumn), _ 234 iArea).RangeAddress) 235 236 ' Customize the Destination Sheet's Columns 237 If Left(reportType, 1) = "P" Then 238 SetWidths(destSheet, endColumn, Array( _ 239 Array("ID", 0), _ 240 Array("Name", 7000), _ 241 Array("Mobile", 0), _ 242 Array("Book", 0) _ 243 )) 244 ElseIf reportType = "SBC" Then 245 SetWidths(destSheet, endColumn, Array( _ 246 Array("ID", 0), _ 247 Array("Name", 4000), _ 248 Array("Address", 11000), _ 249 Array("Mobile", 0) _ 250 )) 251 End If 252 253 If shouldExportPDF Then 254 ExportPDF(destSheet, exportFolder) 255 End If 256 Continue: 257 startRow = (iArea + 1) 258 a = d 259 End If 260 Next iArea 261 262 ErrorHandler: 263 statusBar.end() 264 Reset 265 End Sub 266 </script:module>