juddymar58
Programmer
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 & "" & curRow)
'lngHoursWorked = xlSht.Range("O" & curRow & ":O" & curRow)
'curRunningCost = xlSht.Range("P" & curRow & "" & curRow)
Else
If varPreviousDate <> xlSht.Range("D" & curRow & "" & curRow) Then
'NEW DATE REQURE SUBTOTAL
varPreviousDate = xlSht.Range("D" & curRow & "" & 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 & "" & curRow).Font.Bold = True
.Cells(curRow - 1, 7).Value = "=SUM(O" & lngStartRow & ":O" & curRow - 1 & ")"
.Cells(curRow - 1, 8).Value = "=SUM(P" & lngStartRow & "" & 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 & "" & 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("P2500")
.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 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 & "" & curRow)
'lngHoursWorked = xlSht.Range("O" & curRow & ":O" & curRow)
'curRunningCost = xlSht.Range("P" & curRow & "" & curRow)
Else
If varPreviousDate <> xlSht.Range("D" & curRow & "" & curRow) Then
'NEW DATE REQURE SUBTOTAL
varPreviousDate = xlSht.Range("D" & curRow & "" & 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 & "" & curRow).Font.Bold = True
.Cells(curRow - 1, 7).Value = "=SUM(O" & lngStartRow & ":O" & curRow - 1 & ")"
.Cells(curRow - 1, 8).Value = "=SUM(P" & lngStartRow & "" & 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 & "" & 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("P2500")
.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