Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Changing Access VBA code to export data to OpenOffice Calc

Status
Not open for further replies.

juddymar58

Programmer
Nov 15, 2011
17
AU
Hi all, This is my first post so go easy:) I have done quite a bit of searching but cant seem to find what I'm after.
I currently have an access application that exports data to a new excel file, I then use some vba to loop through and insert subtotals and change formatting in the new file (using excel object).
We will be moving the database to a terminal server setup and I would like to use openoffice calc to now do the formatting of the sheet (avoid having to buy around 80 excel licences). Access still creates the file fine without excel installed. My confusion is about formatting the .xls file without excel.
I'm just wondering this is possible from access using Openoffice Calc? I have been doing some searching and can open and close a file with open office. I'm just not sure if I can actually manipulate the file.
My current code is as follows (basically it just loops through and works out where to put the subtotals in, it also changes the formatting of certain cells in the sheet):

Dim varOutput
Dim strExcelFile As String
strExcelFile = Application.CurrentProject.path & "\Labour Jobsheet.xls"

If Len(Dir(strExcelFile)) > 0 Then
'file exists, delete it!
Kill strExcelFile
End If

'EXPORT DATA TO EXCEL 'THIS CODE STILL WORKS FINE WITHOUT EXCEL
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qryrptInquiryLabourJobsheetReportExcelExport", strExcelFile, True
'varOutput = fHandleFileOpen(strExcelFile, WIN_NORMAL)

'THIS IS WHERE I NEED IT TO FORMAT IN OPEN OFFICE CALC
'Format the spreadsheet
Dim xlApp As Object
Dim xlWkb As Object
Dim xlSht As Object
Dim FlNm As String 'Just the name of the file.

Set xlApp = CreateObject("Excel.Application")
Set xlWkb = xlApp.Workbooks.Open(strExcelFile) ' "fn" is the name
'With path
Set xlSht = xlWkb.Worksheets(1)
FlNm = xlWkb.Name

'--------------------------------------------------------------------
'INSERT SUBTOTALS
Dim curRow As Long
curRow = 2
Dim lngStartRow As Long
lngStartRow = 2
Dim varPreviousDate
Dim lngHoursWorked As Currency
lngHoursWorked = 0

Dim curRunningCost As Currency
curRunningCost = 0

With xlSht.Range("I2:I500")
'Do Until Nz(xlSht.Range("A" & curRow & ":A" & curRow), "") = ""
Do While curRow < 500
If Nz(varPreviousDate, "") = "" Then 'FIRST RECORD NO NEED TO COMPARE
varPreviousDate = xlSht.Range("D" & curRow & ":D" & curRow)
'lngHoursWorked = xlSht.Range("O" & curRow & ":O" & curRow)
'curRunningCost = xlSht.Range("P" & curRow & ":p" & curRow)
Else
If varPreviousDate <> xlSht.Range("D" & curRow & ":D" & curRow) Then

'NEW DATE REQURE SUBTOTAL
varPreviousDate = xlSht.Range("D" & curRow & ":D" & curRow)

'lngHoursWorked = lngHoursWorked + xlSht.Range("I" & curRow & ":I" & curRow)
'-------------------------------------
'NEED TO INSERT SUBTOTAL HERE
.Range("A" & curRow - 1).Select
Call .Range("A" & curRow - 1 & ":A" & curRow).EntireRow.Insert

.Cells(curRow - 1, 6).Value = "Sub Total"

xlSht.Range("M" & curRow & ":p" & curRow).Font.Bold = True

.Cells(curRow - 1, 7).Value = "=SUM(O" & lngStartRow & ":O" & curRow - 1 & ")"
.Cells(curRow - 1, 8).Value = "=SUM(P" & lngStartRow & ":p" & curRow - 1 & ")"
curRow = curRow + 1
lngStartRow = curRow + 1

'.Cells(curRow - 1, -6).Value = ""
'-------------------------------------
' lngHoursWorked = 0
' curRunningCost = 0
'Else
' lngHoursWorked = lngHoursWorked + xlSht.Range("O" & curRow & ":O" & curRow)
' curRunningCost = curRunningCost + xlSht.Range("P" & curRow & ":p" & curRow)
End If

End If

curRow = curRow + 1
Loop
End With

'--------------------------------------------------------------------
'Format the worksheet
With xlSht.Range("A1:Q500")
With .Interior
'.ColorIndex = 15
'.Pattern = xlSolid
End With

With .Font
.ColorIndex = 1
'.Bold = True
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

xlSht.Columns.AutoFit
'xlSht.Range("A2").Select
'xlApp.ActiveWindow.FreezePanes = True

'FORMAT START TIME COLUMN
With xlSht.Range("H2:H500")
.NumberFormat = "h:mm AM/PM"
.HorizontalAlignment = xlRight
End With

'FORMAT END TIME COLUMN
With xlSht.Range("J2:J500")
.NumberFormat = "h:mm AM/PM"
.HorizontalAlignment = xlRight
End With

'FORMAT VALUE COLUMN AS CURRENCY
With xlSht.Range("P2:p500")
.NumberFormat = "$#,##0.00"
.HorizontalAlignment = xlRight
End With

'SET ALIGNMENT OF SOLD COLUMN
With xlSht.Range("I2:I500")
.HorizontalAlignment = xlRight
End With

'SET HEADING ROW TO BOLD
With xlSht.Range("A1:Q1")
.Font.Bold = True
End With

'Rename the sheet to the file name.
xlSht.Name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)

'Save the workbook, clean-up, and exit
xlWkb.Save

Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Quit
Set xlApp = Nothing

'OPEN SPREADSHEET
varOutput = fHandleFileOpen(strExcelFile, WIN_NORMAL)


Any help would be greatly appreciated, as I'm a little stuck on the formatting side of things.

Thanks
Justin
 
I think that the only thing you'll be able to do is to control Excel, and do a SaveAs command, choosing the filetype and/or extension there.

And if you're going to put it into the OpenOffice Calc, you could then create a script in Calc to take care of any nitty gritty items once you get it to that format... so you'd have to save the file, then open it via Windows, then run the code in Calc to finish/tidy it up.

That's just my guess anyway, nothing I've needed to do. I've only piddled (very little) with scripting in Open/Libre Office.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57
 
Hi kjv1611, thank for the reply. Sounds like a good idea. Just create an open office file with script to do what I need and run the file from access. I have found a bit of documentation on automation between vba and starbasic. So I will have a bit of a play around with my initial plan and see how I go. If not I will go down the path you suggested. If anyone has an example of doing this before from access, it would still be greatly appreciated:)
Thanks
Justin
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top