lobasic-macros

Add isPendingReport to distinguish from safety

Fix GetHeaderPosition by returning -1 on error

Remove Highlighted columns automatically after highlighting the rows

Set PageStyles to HorizontallyCenter and enable PageGrid

diff --git a/Standard/Bharatgas.xba b/Standard/Bharatgas.xba
@@ -4,13 +4,18 @@
 'Option VBASupport 1
 Option Explicit
 
-Global Const exportFolder = "C:\Users\bhara\export"
+Global Const exportFolder = "C:\Users\bhara\tSync\Pending-01-07-2024"
 Global Const rowsToSkip = 1
 Global Const insertNewRowFor = False
-Global Const printOnlySummary = True
-Global Const highlightBasedOn = "Payment Option"
+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

@@ -53,7 +58,7 @@ End Sub
 
 Sub SortAreaName(Optional oSheet As Variant, Optional cursor as Variant)
 	Dim oRange as Object
-	Dim oSortFields(0) as new com.sun.star.util.SortField
+	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

@@ -75,8 +80,8 @@ Sub SortAreaName(Optional oSheet As Variant, Optional cursor as Variant)
 	
 	' FIXME This is not working
 	' Date
-	'oSortFields(1).Field = 4
-	'oSortFields(1).SortAscending = True
+	oSortFields(1).Field = 4
+	oSortFields(1).SortAscending = True
 	
 	oSortDesc(0).Name = "SortFields"
     oSortDesc(0).Value = oSortFields

@@ -146,6 +151,7 @@ Function GetHeaderPosition(ByRef oSheet as Object, searchString as String, endCo
 	Dim iColumn as Integer
 	Dim oCell as Object
 	Dim cellString as String
+	GetHeaderPosition = -1
 	If roughHeaderMatch Then
 		searchString = UserFriendlyName(searchString)
 	End If

@@ -173,7 +179,7 @@ Sub HighlightOnline(ByRef oSheet as Object, endColumn as Long, endRow as Long)
 
 	' 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

@@ -181,6 +187,10 @@ Sub HighlightOnline(ByRef oSheet as Object, endColumn as Long, endRow as Long)
 			oCellRange.CellBackColor = RGB(255, 255, 0) ' Yellow
 		End If
 	Next i
+	
+	If highlightRemoveColumn Then
+		oSheet.Columns.removeByIndex(iSearchColumn, 1)
+	End If
 End Sub
 
 

@@ -188,10 +198,21 @@ 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)
+	'oRange = oSheet.getCellRangeByPosition(1, 1, 4, 1)
 	'oCellStyle = ThisComponent.StyleFamilies.getByName("CellStyles").getByName("InterHeader")
-	oRange.CellStyle = "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

@@ -212,6 +233,7 @@ Sub Main
 	Dim areaRange, idRange, bookRange
 	Dim headerRange as Object
 	Dim cellRangeToCopy as Object
+	Dim pageStyle as Object
 
 	s = ThisComponent.Sheets(0)
 	cursor = UsedRangeCursor(s)

@@ -225,7 +247,9 @@ Sub Main
 	' Transformations to be applied to the Main sheet before splitting the sheet by Area Name
 	'Call UnFreezeSelection
 	cursor = UsedRangeCursor(s)
-	Call HighlightOnline(s, endColumn, endRow)
+	If isPendingReport Then
+		Call HighlightOnline(s, endColumn, endRow)
+	End If
 	Call SortAreaName(s, cursor)
 	Call CleanColumnHeaders(s, endColumn)
 	

@@ -241,6 +265,7 @@ Sub Main
 	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

@@ -261,13 +286,18 @@ Sub Main
 			
 			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 & " - PENDING"
+			sheetName = a & sheetNameSuffix
 
 			' Copy the Headers from the Main Document
 			' FIXME This DOES NOT work when using with filtered data

@@ -282,12 +312,29 @@ Sub Main
 			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
-			destSheet.getColumns().getByName("B").Width = 2500
-			destSheet.getColumns().getByName("C").Width = 4500
-			'destSheet.getColumns().getByName("F").Width = 8000
+			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

@@ -303,8 +350,11 @@ Sub Main
 			destSheet.getColumns().removeByIndex(0, 1)
 			destSheet.getColumns().removeByIndex(4, 1)
 			
+
 			'TODO Maybe use Dispatcher?
-			ExportPDF(destSheet)
+			If shouldExportPDF Then
+				ExportPDF(destSheet)
+			End If
 			Continue:
 			startRow = (iArea + 1)
 			a = d

@@ -344,27 +394,17 @@ Sub ExportPDF(Optional ByVal oSheet as Object)
 	fileName = exportFolder & "\" & oSheet.Name & ".pdf"
 	fileUrl = ConvertToUrl(fileName)
 	
-	args(0).Name = "FilterName"
-	args(0).Value = "calc_pdf_Export"
-
-	fd(0).Name = "Selection"
-	fd(0).Value = cursor
+	With args(0) : .Name = "FilterName" : .Value = "calc_pdf_Export" : End With
+	WIth fd(0) : .Name = "Selection" : .Value = cursor : End With
 	
 	' conflicts with the Selection
-	fd(1).Name = "SinglePageSheets"
-	fd(1).Value = False
-	
-	fd(2).Name = "IsSkipEmptyPages"
-	fd(2).Value = True
+	With fd(1) : .Name = "SinglePageSheets" : .Value = False : End With
+	With fd(2) : .Name = "IsSkipEmptyPages" : .Value = True : End With
 		
-	args(1).Name = "FilterData"
-	args(1).Value = fd
-	
-	args(2).Name = "Overwrite"
-	args(2).Value = True
+	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