Attachment 173504 Details for Bug 143297 – BASIC macros using attached Calc file [REFERENCE ONLY]

BASIC macros using attached Calc file [REFERENCE ONLY]

LO_Basic_macros.txt (text/plain), 12.85 KB, created by Andrew Richardson on 2021-07-12 12:11:12 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Andrew Richardson

Created: 2021-07-12 12:11:12 UTC

Size: 12.85 KB

patch

obsolete

>'Routine to open Waterfront Reservations Daily Summary report
>Sub OpenReportWaterDaily(Optional poEvent As Object)
>    Dim ofForm As Object, odReportDate As Object
>	Dim oStatusBar As Object
>	Dim odOutput As Object
>	Dim pvArgs(2) As New com.sun.star.beans.PropertyValue
>	Dim oDBRanges()
>    DIM oSheet
>	DIM RangeNames()
>	DIM ColumnNames()
>	DIM oRowSet, nRow
>    DIM oCursor
>	DIM i,j
>	
>	If _ErrorHandler() Then On Local Error Goto Error_Function
>	Utils._SetCalledSub("OpenReportWaterDaily")
>
>    'Create objects of required type
>	Set odOutput        = createunoservice("com.sun.star.text.TextDocument")
>
>    oStatusBar = ThisComponent.getCurrentController.StatusIndicator
>    oStatusBar.start("Generating Report...please wait",0)
>
>	Set ofForm         = Events(poEvent).Source.getProperty("Parent")
>	Set odReportDate   = ofForm.Controls("datReportDate")
>
>	'Create main report view
>	CreateTempWaterDailyViews(odReportDate.Value)
>
>	'Open TEMPLATE file and update links
>	pvArgs(0).Name  = "UpdateDocMode" : pvArgs(0).Value =  com.sun.star.document.UpdateDocMode.QUIET_UPDATE
>	pvArgs(1).Name  = "MacroExecutionMode" : pvArgs(1).Value = com.sun.star.document.MacroExecMode.USE_CONFIG
>	Set odOutput = StarDesktop.loadComponentFromURL(acWaterDayRepURL, "_blank", 0, pvArgs) 'returns XComponent
>
>	'Refresh database ranges within spreadsheet
>	oDBRanges = odOutput.DatabaseRanges
>    For i = 0 To (oDBRanges.Count-1)
>		'Update DB range contents
>        oDBRanges(i).refresh()
>	Next 'i
>
>
>	'Mapping of block range name and database range name
>	RangeNames() = Array( Array("Time_7AM", "Import1"), _
>	                      Array("Time_8AM", "Import2"), _
>	                      Array("Time_9AM", "Import3"), _
>	                      Array("Time_10AM","Import4"), _
>	                      Array("Time_11AM","Import5"), _
>	                      Array("Time_12PM","Import6"), _
>	                      Array("Time_1PM", "Import7"), _
>	                      Array("Time_2PM", "Import8"), _
>	                      Array("Time_3PM", "Import9"), _
>	                      Array("Time_4PM", "Import10"), _
>	                      Array("Time_5PM", "Import11"), _
>	                    )
>	                    
>	'Mapping of column index and name
>	ColumnNames() = Array( Array(3, "#People"), _
>					  	   Array(4, "#Kayaks"), _
>						   Array(5, "#DblKayaks"), _
>						   Array(6, "#Canoes"), _
>						   Array(7, "#Tubes"), _
>						   Array(8, "#Coolers"), _
>						   Array(9, "#Rafts"), _
>					  )
>	             
>	oSheet = odOutput.getSheets().getByIndex(0) 
>	
>	'Bug workaround: some data rows hidden
>    oCursor  = oSheet.createCursorByRange(oSheet.getCellRangeByName("A4:A300"))
>    oRowSet = oCursor.Rows()
>    For nRow = 0 To (oRowSet.getCount()-1)
>    	If NOT oRowSet(nRow).IsVisible Then
>    		oRowSet(nRow).IsVisible = TRUE
>    	End If
>    	oRowSet(nRow).Height = 635 '0.25" => 6.35mm
>    	oRowSet(nRow).OptimalHeight = True
>    Next 'nRow
>    
>	'Loop over the RangeNames map
>    For i = LBound(RangeNames) To UBound(RangeNames)
>        DIM aTimeBlock()
>        DIM sName
>        DIM oFuncRange
>        DIM oFuncCell
>        DIM oTimeCell
>        DIM oTimeTxt
>        DIM oDBRange
>        DIM oAddress
>		DIM oAddr
>		DIM iOffset
>		DIM iRowOffset
>        DIM oBorderLine As New com.sun.star.table.BorderLine2
>
>		oBorderLine.Color = 0 'black
>		oBorderLine.InnerLineWidth = 0
>		oBorderLine.OuterLineWidth = 60 'in 1/100 mm
>		oBorderLine.LineDistance = 0
>
>
>		aTimeBlock = RangeNames(i)
>		oTimeCell = oSheet.getCellRangeByName(aTimeBlock(0))
>		oDBRange = oSheet.getCellRangeByName(aTimeBlock(1))
> 
>		'Check if DB cell range has data
>		oAddress = oDBRange.getRangeAddress()
>		oCursor  = oSheet.createCursor()
>		If oAddress.StartRow <> oAddress.EndRow Then
>
>		    'Fix loss of time field in first row sometimes
>			oTimeTxt = oTimeCell.GetString()   
>			oTimeCell.SetString("")
>			oDBRange.getCellByPosition(1,1).SetString( oTimeTxt )   
>
>			oFuncRange = oCursor.getCellRangeByPosition( oAddress.StartColumn, oAddress.StartRow, _
>				                                         oAddress.EndColumn,   oAddress.StartRow )
>
>            iRowOffset = 1
>
>
>	        'Use (Address+1 row) as reference
>'			oFuncRange = oCursor.getCellRangeByPosition( oAddress.StartColumn, oAddress.StartRow+1, _
>'				                                         oAddress.EndColumn,   oAddress.StartRow+1 )
>	        'Generate subtotals for each numeric column
>'		    For j = LBound(ColumnNames) To UBound(ColumnNames)
>'		        oAddr = oTimeCell.getCellAddress()
>'		    	iOffset = ColumnNames(j)(0)
>		    	
>		        'Function on single column
>'				oFuncRange = oCursor.getCellRangeByPosition( (oAddress.StartColumn + iOffset), 0, _
>'				                                             (oAddress.StartColumn + iOffset), (oAddress.EndRow-oAddress.StartRow) )
>' 				oFuncCell =  oSheet.getCellByPosition( (oAddr.Column + iOffset -1), oAddr.Row )
>' 				
>'				oFuncCell.SetValue( oFuncRange.computeFunction(com.sun.star.sheet.GeneralFunction.SUM) )
>'				oFuncCell.CharPosture = 2 'Italic
>
>'		    Next 'j
>		    
>		    'Add Totals label
>'			oTimeCell.SetString("Totals:")
>'			oTimeCell.CharWeight =  com.sun.star.awt.FontWeight.BOLD
>'			oTimeCell.CharPosture = 2 'Italic
>'			oTimeCell.HoriJustify =  com.sun.star.table.CellHoriJustify.RIGHT
>
>        Else
>	        'Use TimeCell as reference
>		    oAddress = oTimeCell.getCellAddress()
>			oFuncRange = oCursor.getCellRangeByPosition( oAddress.Column,    oAddress.Row, _
>				                                         oAddress.Column+11, oAddress.Row )			 
>            iRowOffset = 0
>		End If
>
>		'Break page if range likely to spill over
>		If 62 < ((oFuncRange.RangeAddress.EndRow + 8) Mod 70) Then
>            oTimeCell.getRows().GetByIndex(0).IsStartOfNewPage = True
>		End If
>
>		'Hide headers after first set
>	    oCursor  = oSheet.createCursorByRange(oDBRange)
>        oRowSet = oCursor.Rows()
>
>		'Draw border between time blocks
>		For j = oFuncRange.RangeAddress.StartColumn To oFuncRange.RangeAddress.EndColumn
>			oFuncCell =  oSheet.getCellByPosition( j, oFuncRange.RangeAddress.StartRow + iRowOffset )
>			oFuncCell.TopBorder = oBorderLine			
>		Next 'j
>
>		'Fix odd formatting behavior
>		oDBRange.CharWeight = com.sun.star.awt.FontWeight.BOLD
>
>		'Skip first time block
>		If 0 <> i Then
>			oRowSet(0).IsVisible = FALSE
>    	End If
>
>	Next 'i
>
>	
>	'Save report 
>	pvArgs(0).Name  = "Overwrite" : pvArgs(0).Value = True
>	pvArgs(1).Name  = "ReadOnly"  : pvArgs(1).Value = False
>    odOutput.storeAsURL(acWaterDayOutURL, pvArgs)
>
>Exit_Function:
>    oStatusBar.end()
>	Utils._ResetCalledSub("OpenReportWaterDaily")
>	Exit Sub
>
>Error_Function:
>	TraceError(TRACEABORT, Err, "OpenReportWaterDaily", Erl)
>	GoTo Exit_Function
>End Sub
>
>
>
>
>'Routine to create Waterfronts Reservations Daily report views
>Sub CreateTempWaterDailyViews(pdReportDate as Date)
>    Dim sCommand As String
>    Dim i As Integer, bResult As Boolean
>
>    If _ErrorHandler() Then On Local Error Goto Error_Function
>    Utils._SetCalledSub("CreateTempWsDailyViews")
>            
>    sCommand =  "DROP VIEW IF EXISTS [TEMP_WF_DAILY]"
>    bResult = DoCmd.RunSQL(sCommand)
>    if NOT bResult Then
>            TraceError(TRACEERROR, Err, "Error on SQL statement:" & sCommand, Erl)
>    End If
>
>    'Create report views
>    sCommand =  "CREATE VIEW [TEMP_WF_DAILY] AS " & _
>                "SELECT [C].[FullName] AS [NAME], " & _
>                "       [R].[TripDate] AS [TRIPDATE], " & _ 
>                "       [R].[TripTime] AS [TRIPTIME], " & _ 
>                "       DECODE([R].[NumPeople],   0,NULL,[R].[NumPeople]) AS [#People], " & _
>                "       DECODE([R].[NumCanoes],   0,NULL,[R].[NumCanoes]) AS [#Canoes], " & _
>                "       DECODE([R].[NumKayaks],   0,NULL,[R].[NumKayaks]) AS [#Kayaks], " & _
>                "       DECODE([R].[NumDblKayaks],0,NULL,[R].[NumDblKayaks]) AS [#Double], " & _
>                "       DECODE([R].[NumTubes],    0,NULL,[R].[NumTubes]) AS [#Tubes], " & _
>                "       DECODE([R].[NumDblTubes], 0,NULL,[R].[NumDblTubes]) AS [#DTubes], " & _
>                "       DECODE([R].[NumCoolers],  0,NULL,[R].[NumCoolers]) AS [#Coolers], " & _
>                "       DECODE([R].[NumDingys],   0,NULL,[R].[NumDingys]) AS [#Dingys], " & _
>                "       DECODE([R].[BookType],'Rental',FALSE,TRUE) AS [Shuttle], " & _
>                "       [R].[PutIn] AS [PUTIN], " & _
>                "       [R].[TakeOut] AS [TAKEOUT], " & _
>                "       TRIM(DECODE([R].[BookType],'Rental',   'RENTAL ONLY;', " & _
>                "                                  'Transport','TRANS:'||DECODE([R].[NumSUPs],     0,'',[R].[NumSUPs]||'SUP;') " & _
>                "                                                      ||DECODE([R].[NumTubes],    0,'',[R].[NumTubes]||'T;') " & _
>                "                                                      ||DECODE([R].[NumDblTubes], 0,'',[R].[NumDblTubes]||'DT;') " & _                
>                "                                                      ||DECODE([R].[NumCoolers],  0,'',[R].[NumCoolers]||'CLR;') " & _
>                "                                                      ||DECODE([R].[NumDingys],   0,'',[R].[NumDingys]||'RFT;') " & _
>                "                                                      ||DECODE([R].[NumCChairs],  0,'',[R].[NumCChairs]||'CHR;') " & _
>                "                                                      ||DECODE([R].[NumPaddles],  0,'',[R].[NumPaddles]||'PDL;') " & _
>                "                                                      ||DECODE([R].[NumPFDs],     0,'',[R].[NumPFDs]||'PFD;') ) " & _
>                "            ||NVL([R].[Notes],'')) AS [Notes] " & _
>                "FROM [PUBLIC].[WaterfrontReservations] [R], [PUBLIC].[Customers] [C] " & _
>                "WHERE [R].[CustomerID] = [C].[ID] " & _
>                "  AND [R].[TripDate] = '" & Format(pdReportDate, "yyyy-mm-dd") & "' " & _
>                "  AND NVL([R].[Cancelled],False) = False " & _
>                "  AND [R].[BookType] != 'Transport' " & _
>                "UNION " & _
>                "SELECT [C].[FullName] AS [NAME], " & _
>                "       [R].[TripDate] AS [TRIPDATE],  " & _
>                "       [R].[TripTime] AS [TRIPTIME],  " & _
>                "       [R].[NumPeople] AS [#People], " & _
>                "       NULL AS [#Canoes], " & _
>                "       NULL AS [#Kayaks], " & _
>                "       NULL AS [#Double], " & _
>                "       NULL AS [#Tubes], " & _
>                "       NULL AS [#DTubes], " & _
>                "       NULL AS [#Coolers], " & _
>                "       NULL AS [#Dingys], " & _
>                "       DECODE([R].[BookType],'Rental',FALSE,TRUE) AS [Shuttle], " & _
>                "       [R].[PutIn] AS [PUTIN], " & _
>                "       [R].[TakeOut] AS [TAKEOUT], " & _
>                "       TRIM(DECODE([R].[BookType],'Rental',   'RENTAL ONLY;', " & _
>                "                                  'Transport','TRANS:'||DECODE([R].[NumCanoes],    0,'',[R].[NumCanoes]||'C;') " & _
>                "                                                      ||DECODE([R].[NumKayaks],    0,'',[R].[NumKayaks]||'K;') " & _
>                "                                                      ||DECODE([R].[NumDblKayaks], 0,'',[R].[NumDblKayaks]||'DK;') " & _
>                "                                                      ||DECODE([R].[NumTubes],     0,'',[R].[NumTubes]||'T;') " & _
>                "                                                      ||DECODE([R].[NumDblTubes],  0,'',[R].[NumDblTubes]||'DT;') " & _                
>                "                                                      ||DECODE([R].[NumSUPs],      0,'',[R].[NumSUPs]||'SUP;') " & _
>                "                                                      ||DECODE([R].[NumCoolers],   0,'',[R].[NumCoolers]||'CLR;') " & _
>                "                                                      ||DECODE([R].[NumDingys],    0,'',[R].[NumDingys]||'RFT;') ) " & _
>                "            ||NVL([R].[Notes],'')) AS [Notes] " & _
>                "FROM [PUBLIC].[WaterfrontReservations] [R], [PUBLIC].[Customers] [C] " & _
>                "WHERE [R].[CustomerID] = [C].[ID] " & _
>                "  AND [R].[TripDate] = '" & Format(pdReportDate, "yyyy-mm-dd") & "' " & _
>                "  AND NVL([R].[Cancelled],False) = False " & _
>                "  AND [R].[BookType] = 'Transport' " & _
>                "ORDER BY 3 ASC, 13 DESC, 4 DESC"
>
>    bResult = DoCmd.RunSQL(sCommand)
>    if NOT bResult Then
>        TraceError(TRACEERROR, Err, "Error on SQL statement:" & sCommand, Erl)
>    End If
>
>Exit_Function:
>    Utils._ResetCalledSub("CreateTempWsDailyViews")
>    Exit Sub
>
>Error_Function:
>    TraceError(TRACEABORT, Err, "CreateTempWsDailyViews", Erl)
>    GoTo Exit_Function
>End Sub
>
>
>
>
>

Actions: View

Attachments on bug 143297: 173491 | 173504