PDA

View Full Version : Solved: Excel borders from Access with VBA



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

jludt
05-26-2010, 05:53 AM
I'm going to go ahead and solve my own problem.

Dim xlapp As Object
Dim wk As Object
Dim xlSheet As Object
Dim sheetname
Dim r As Object


sheetname = "New Sheet Name"
Set xlapp = CreateObject("Excel.Application")


xlapp.Workbooks.Add
xlapp.Worksheets(1).Name = sheetname

xlapp.Visible = True
Set r = xlapp.Worksheets(sheetname).Range("A2:Z2")

With r
.Borders.Weight = 4
.Value = "Done!"
End With


I'm guessing I had no replies either because I pasted all of my messy code instead of just the portion I was trying to solve or that this was so easy of a problem that no one bothered wasting keystrokes. Oh well at least its solved.