[Libreoffice-commits] core.git: wizards/source
Jean-Pierre Ledure
jp at ledure.be
Tue Dec 8 07:43:18 PST 2015
wizards/source/access2base/Database.xba | 105 ++++++++++++++++++++++++++---
wizards/source/access2base/DoCmd.xba | 8 +-
wizards/source/access2base/acConstants.xba | 3
3 files changed, 102 insertions(+), 14 deletions(-)
New commits:
commit 04ebc52c262ea495abf1ed72e60656710504475b
Author: Jean-Pierre Ledure <jp at ledure.be>
Date: Tue Dec 8 16:38:26 2015 +0100
Access2Base - DoCmd.OutputTo applicable to Calc, Excel and Text/csv formats
Database._OutputToCalc uses LO filters to export table and/or query data
Change-Id: I69b15e76a490de32ec2cae73661f8ffd5f2b53b2
diff --git a/wizards/source/access2base/Database.xba b/wizards/source/access2base/Database.xba
index 8d524b6..2398de8 100644
--- a/wizards/source/access2base/Database.xba
+++ b/wizards/source/access2base/Database.xba
@@ -591,7 +591,7 @@ Public Function OutputTo(ByVal pvObjectType As Variant _
, ByVal Optional pvEncoding As Variant _
, ByVal Optional pvQuality As Variant _
) As Boolean
-'Supported: acFormatHTML for tables and queries
+'Supported: acFormatHTML, acFormatODS, acFormatXLS, acFormatXLSX, acFormatTXT for tables and queries
If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "Database.OutputTo"
@@ -607,8 +607,9 @@ Const cstThisSub = "Database.OutputTo"
If pvOutputFormat <> "" Then
If Not Utils._CheckArgument(UCase(pvOutputFormat), 3, vbString, Array( _
UCase(acFormatHTML), "HTML" _
- , UCase(acFormatXLS), "XLS" _
, UCase(acFormatODS), "ODS" _
+ , UCase(acFormatXLS), "XLS" _
+ , UCase(acFormatXLSX), "XLSX" _
, UCase(acFormatTXT), "TXT", "CSV" _
, "")) _
Then Goto Exit_Function ' A 2nd time to allow case unsensitivity
@@ -625,7 +626,7 @@ Const cstThisSub = "Database.OutputTo"
If Not Utils._CheckArgument(pvQuality, 7, _AddNumeric(), Array(acExportQualityPrint, acExportQualityScreen)) Then Goto Exit_Function
Dim sOutputFile As String, bFound As Boolean, i As Integer, iCount As Integer, oTable As Object
-Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutput As Boolean
+Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutput As Boolean, sSuffix As String
'Find applicable table or query
bFound = False
If pvObjectType = acOutputTable Then iCount = TableDefs.Count Else iCount = Querydefs.Count
@@ -640,17 +641,21 @@ Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutp
'Determine format and parameters
If pvOutputFormat = "" Then
- sOutputFormat = _PromptFormat(Array("HTML", "ODS", "XLS", "TXT")) ' Prompt user for format
+ sOutputFormat = _PromptFormat(Array("HTML", "ODS", "XLS", "XLSX", "TXT")) ' Prompt user for format
If sOutputFormat = "" Then Goto Exit_Function
- If Not Utils._CheckArgument(UCase(sOutputFormat), 3, vbString, Array(UCase(acFormatHTML), "HTML", "")) _
- Then Goto Exit_Function ' Today only value, later maybe Calc ?
Else
sOutputFormat = UCase(pvOutputFormat)
End If
'Determine output file
If pvOutputFile = "" Then ' Prompt file picker to user
- sSuffix = "html"
+ Select Case sOutputFormat
+ Case UCase(acFormatHTML), "HTML" : sSuffix = "html"
+ Case UCase(acFormatODS), "ODS" : sSuffix = "ods"
+ Case UCase(acFormatXLS), "XLS" : sSuffix = "xls"
+ Case UCase(acFormatXLSX), "XLSX" : sSuffix = "xlsx"
+ Case UCase(acFormatTXT), "TXT", "CSV" : sSuffix = "txt"
+ End Select
sOutputFile = _PromptFilePicker(sSuffix)
If sOutputFile = "" Then Goto Exit_Function
Else
@@ -659,7 +664,18 @@ Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutp
sOutputFile = ConvertToURL(sOutputFile)
'Create file
- bOutput = _OutputToHTML(oTable, sOutputFile, pvTemplateFile)
+ Select Case sOutputFormat
+ Case UCase(acFormatHTML), "HTML"
+ bOutput = _OutputToHTML(oTable, sOutputFile, pvTemplateFile)
+ Case UCase(acFormatODS), "ODS"
+ bOutput = _OutputToCalc(oTable, sOutputFile, acFormatODS)
+ Case UCase(acFormatXLS), "XLS"
+ bOutput = _OutputToCalc(oTable, sOutputFile, acFormatXLS)
+ Case UCase(acFormatXLS), "XLSX"
+ bOutput = _OutputToCalc(oTable, sOutputFile, acFormatXLSX)
+ Case UCase(acFormatTXT), "TXT", "CSV"
+ bOutput = _OutputToCalc(oTable, sOutputFile, acFormatTXT)
+ End Select
oTable.Dispose()
'Launch application, if requested
@@ -1159,14 +1175,14 @@ End Function ' _OutputNullToHTML V1.4.0
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _OutputNumberToHTML(ByVal pvNumber As Variant, ByVal Optional piPrecision As Integer) As String
-' Converts input date to HTML compatible string
+' Converts input number to HTML compatible string
Dim vNumber As Variant
If IsMissing(piPrecision) Then piPrecision = -1
If pvNumber = Int(pvNumber) Then
vNumber = Int(pvNumber)
Else
- If piPrecision >= 0 Then vNumber = (Int(pvNumber * 10 ^ piPrecision + 0.5)) / 10 ^ piPrecision Else vNumber = Int(pvNumber)
+ If piPrecision >= 0 Then vNumber = (Int(pvNumber * 10 ^ piPrecision + 0.5)) / 10 ^ piPrecision Else vNumber = pvNumber
End If
_OutputNumberToHTML = Format(vNumber)
@@ -1264,6 +1280,75 @@ Dim i As Integer, l As Long
End Function ' _OutputStringToHTML V1.4.0
REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputToCalc(poData As Object, ByVal psOutputFile As String, psFilter As String) As Boolean
+' https://wiki.openoffice.org/wiki/Documentation/DevGuide/Spreadsheets/Database_Import
+
+Dim oCalcDoc As Object, oSheet As Object, vWin As Variant
+Dim vImportDesc() As Variant, iSource As Integer
+Dim oRange As Object, i As Integer, iCol As Integer, oColumns As Object
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+ _OutputToCalc = False
+ ' Create a new OO-Calc-Document
+ Set oCalcDoc = StarDesktop.LoadComponentFromURL( _
+ "private:factory/scalc" _
+ , "_default" ,0, Array() _
+ )
+
+ ' Get the unique spreadsheet
+ Set oSheet = oCalcDoc.Sheets(0)
+
+ ' Describe import
+ With poData
+ If ._Type = "TABLEDEF" Then
+ iSource = com.sun.star.sheet.DataImportMode.TABLE
+ Else
+ iSource = com.sun.star.sheet.DataImportMode.QUERY
+ End If
+ vImportDesc = Array( _
+ _MakePropertyValue("DatabaseName", URL) _
+ , _MakePropertyValue("SourceType", iSource) _
+ , _MakePropertyValue("SourceObject", ._Name) _
+ )
+ oSheet.Name = ._Name
+ End With
+
+ ' Import
+ oSheet.getCellByPosition(0, 0).doImport(vImportDesc())
+
+ Select Case psFilter
+ Case acFormatODS, acFormatXLS, acFormatXLSX ' Formatting
+ iCol = poData.Fields().Count
+ Set oRange = oSheet.getCellRangeByPosition(0, 0, iCol - 1, 0)
+ oRange.CharWeight = com.sun.star.awt.FontWeight.BOLD
+ oRange.CellBackColor = RGB(200, 200, 200)
+ oRange.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
+ Set oColumns = oRange.getColumns()
+ For i = 0 To iCol - 1
+ oColumns.getByIndex(i).OptimalWidth = True
+ Next i
+ Case Else
+ End Select
+
+ oCalcDoc.storeAsUrl(psOutputFile, Array( _
+ _MakePropertyValue("FilterName", psFilter) _
+ , _MakePropertyValue("Overwrite", True) _
+ ))
+ oCalcDoc.close(False)
+ _OutputToCalc = True
+
+Exit_Function:
+ Set oColumns = Nothing
+ Set oRange = Nothing
+ Set oSheet = Nothing
+ Set oCalcDoc = Nothing
+ Exit Function
+Error_Function:
+ TraceError(TRACEABORT, ERRDFUNCTION, _A2B_.CalledSub, 0, , sSQL)
+ Goto Exit_Function
+End Function ' OutputToCalc V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Public Function _OutputToHTML(poTable As Object, ByVal psOutputFile As String, ByVal psTemplateFile As String) As Boolean
' http://www.ehow.com/how_5652706_create-html-template-ms-access.html
diff --git a/wizards/source/access2base/DoCmd.xba b/wizards/source/access2base/DoCmd.xba
index d4f5706..ff3d5ae 100644
--- a/wizards/source/access2base/DoCmd.xba
+++ b/wizards/source/access2base/DoCmd.xba
@@ -1212,9 +1212,11 @@ Public Function OutputTo(ByVal pvObjectType As Variant _
, ByVal Optional pvEncoding As Variant _
, ByVal Optional pvQuality As Variant _
) As Boolean
+REM https://wiki.openoffice.org/wiki/Framework/Article/Filter/FilterList_OOo_3_0
REM https://wiki.openoffice.org/wiki/Documentation/DevGuide/Spreadsheets/Filter_Options
+REM https://msdn.microsoft.com/en-us/library/ms709353%28v=vs.85%29.aspx
'Supported: acFormatPDF, acFormatODT, acFormatDOC, acFormatHTML for forms
-' acFormatHTML, acFormatXLS, acFormatODS, acFormatTXT for tables and queries
+' acFormatHTML, acFormatODS, acFormatXLS, acFormatXLSX, acFormatTXT for tables and queries
If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "OutputTo"
@@ -1230,8 +1232,8 @@ Const cstThisSub = "OutputTo"
If pvOutputFormat <> "" Then
If Not Utils._CheckArgument(UCase(pvOutputFormat), 3, vbString, Array( _
UCase(acFormatPDF), UCase(acFormatODT), UCase(acFormatDOC), UCase(acFormatHTML) _
- , UCase(acFormatXLS), UCase(acFormatODS), UCase(acFormatTXT) _
- , "PDF", "ODT", "DOC", "HTML", "XLS", "ODS", "TXT", "CSV", "" _
+ , UCase(acFormatODS), UCase(acFormatXLS), UCase(acFormatXLSX), UCase(acFormatTXT) _
+ , "PDF", "ODT", "DOC", "HTML", "ODS", "XLS", "XLSX", "TXT", "CSV", "" _
)) Then Goto Exit_Function ' A 2nd time to allow case unsensitivity
End If
If IsMissing(pvOutputFile) Then pvOutputFile = ""
diff --git a/wizards/source/access2base/acConstants.xba b/wizards/source/access2base/acConstants.xba
index 08e442a..1a3db6a 100644
--- a/wizards/source/access2base/acConstants.xba
+++ b/wizards/source/access2base/acConstants.xba
@@ -287,8 +287,9 @@ Global Const acFormatPDF = "writer_pdf_Export"
Global Const acFormatODT = "writer8"
Global Const acFormatDOC = "MS Word 97"
Global Const acFormatHTML = "HTML"
+Global Const acFormatODS = "calc8"
Global Const acFormatXLS = "MS Excel 97"
-Global Const acFormatODS = "StarOffice XML (Calc)"
+Global Const acFormatXLSX = "Calc MS Excel 2007 XML"
Global Const acFormatTXT = "Text - txt - csv (StarCalc)"
REM AcExportQuality
More information about the Libreoffice-commits
mailing list