jludt
05-24-2010, 02:03 PM
Excuse the sloppy code. But this is my feeble attempt at trying to format borders into an Excel spreadsheet from Access. Eventually I am going to populate the spreadsheet with queries from a table in Access but for now since I'm still new to VBA I am sticking with formatting and such. So this is what I have so far is there anyone that can point me in the right direction. I appreciate any and all insight. Thanks you.
Private Sub Command185_Click()
'Application.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "LexingtonCommissions", "C:\Book1.xls", False, ""
'Attempt to bind to an open instance
Dim xlApp As Object
Dim ExcelRunning As Boolean
Dim XLDoc As Object
Dim r As Object
Dim objsheets As Object
'Dim xlEdgeBottom As Object
Dim xlcontinuous As Object
'Dim xlThin As Object
Const xlEdgeBottom = 9
Const xlThin = 2
Const xlDouble = -4119
Const xlThick = 4
'Check if excel is open if not open in instance
ExcelRunning = IsExcelRunning()
If ExcelRunning Then
Set xlApp = GetObject(, "Excel.Application")
Else
Set xlApp = CreateObject("Excel.Application")
End If
'If Not ExcelRunning Then xlApp.Quit
'Set xlApp = Nothing
'Opening document in excel
'Set XLDoc = xlApp.workbooks.Open("c:\test.xls")
'xlApp.workbooks.Open FileName:="c:\test.xls", ReadOnly:=True
xlApp.Visible = True
Set objsheets = xlApp.workbooks.Add
'Format the headers
xlApp.Range("A2:D6").Font.Bold = True
'xlApp.Range("A1:R1").HorizontalAlignment = xlCenter
xlApp.Range("A2:D6").Font.ColorIndex = 2
xlApp.Range("A2:D6").Interior.ColorIndex = 1
'xlApp.Range("A2:D6").ActiveCell.Borders(2).Color = RGB(0, 0, 0)
'xlApp.Cells(1, 1).Borders(xlEdgeBottom).Weight = xlThick
'xlApp.Cells(1, 1).Borders(xlEdgeBottom).ColorIndex = 5
'xlApp.Cells(1, 1).Borders(xlEdgeBottom).LineStyle = xlDouble
'xlApp.Range("A2:D6").Borders(xlEdgeBottom).LineStyle = xlcontinuous
'xlApp.Range("A2:D6").Borders(xlEdgeBottom).Weight = xlThin
'AutoFit the columns
xlApp.Range("A:R").Columns.AutoFit
'Freeze Panes
'xlApp.Activate
xlApp.Range("2:2").Select
xlApp.ActiveWindow.FreezePanes = True
'Set the cursor back on the first cell
xlApp.Range("A1:A1").Select
Exit_Command185_Click:
Exit Sub
Err_Command185_Click:
MsgBox Err.Description
Resume Exit_Command185_Click
End Sub
Private Sub Command185_Click()
'Application.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "LexingtonCommissions", "C:\Book1.xls", False, ""
'Attempt to bind to an open instance
Dim xlApp As Object
Dim ExcelRunning As Boolean
Dim XLDoc As Object
Dim r As Object
Dim objsheets As Object
'Dim xlEdgeBottom As Object
Dim xlcontinuous As Object
'Dim xlThin As Object
Const xlEdgeBottom = 9
Const xlThin = 2
Const xlDouble = -4119
Const xlThick = 4
'Check if excel is open if not open in instance
ExcelRunning = IsExcelRunning()
If ExcelRunning Then
Set xlApp = GetObject(, "Excel.Application")
Else
Set xlApp = CreateObject("Excel.Application")
End If
'If Not ExcelRunning Then xlApp.Quit
'Set xlApp = Nothing
'Opening document in excel
'Set XLDoc = xlApp.workbooks.Open("c:\test.xls")
'xlApp.workbooks.Open FileName:="c:\test.xls", ReadOnly:=True
xlApp.Visible = True
Set objsheets = xlApp.workbooks.Add
'Format the headers
xlApp.Range("A2:D6").Font.Bold = True
'xlApp.Range("A1:R1").HorizontalAlignment = xlCenter
xlApp.Range("A2:D6").Font.ColorIndex = 2
xlApp.Range("A2:D6").Interior.ColorIndex = 1
'xlApp.Range("A2:D6").ActiveCell.Borders(2).Color = RGB(0, 0, 0)
'xlApp.Cells(1, 1).Borders(xlEdgeBottom).Weight = xlThick
'xlApp.Cells(1, 1).Borders(xlEdgeBottom).ColorIndex = 5
'xlApp.Cells(1, 1).Borders(xlEdgeBottom).LineStyle = xlDouble
'xlApp.Range("A2:D6").Borders(xlEdgeBottom).LineStyle = xlcontinuous
'xlApp.Range("A2:D6").Borders(xlEdgeBottom).Weight = xlThin
'AutoFit the columns
xlApp.Range("A:R").Columns.AutoFit
'Freeze Panes
'xlApp.Activate
xlApp.Range("2:2").Select
xlApp.ActiveWindow.FreezePanes = True
'Set the cursor back on the first cell
xlApp.Range("A1:A1").Select
Exit_Command185_Click:
Exit Sub
Err_Command185_Click:
MsgBox Err.Description
Resume Exit_Command185_Click
End Sub