Access controlled Excel format

  • Thread starter Thread starter Pendragon
  • Start date Start date
P

Pendragon

Access03/WinXP

I have data being written to an Excel Workbook template and through loops am
moving to specific cells in the template. I don't have any issue writing
data into the cells; however, I have not been able to figure out how to
format the cell.

With .Activesheet
.Range(stCell).Offset(0, icolumn).Value = CName
.Range(stCell).Offset(0, icolumn).Select
With Selection
.HorizontalAlignment = xlcenter
.Font.Bold = True
End With
End With

'CName' is a string variable. The first two lines work; "Object Required"
is the error message received when the code hits the horizontal alignment
line.

Any help appreciated. Also, any websites with some thorough shop talk on
controlling/formatting Excel from Access? I have not been able to find much.

Thanks!
 
Here's some fairly crude code I use to put out the basic DB structure to
Excel
but it does have some formatting of the Excel sheet.

Regards

Kevin

Sub TableAndFieldList()
Dim lngTable As Long
Dim lngField As Long
Dim db As Database
Dim xlApp As Object
Dim wbExcel As Object
Dim ws As Worksheet
Dim lngRow As Long
Set db = CurrentDb
Set xlApp = CreateObject("Excel.Application")
Set wbExcel = xlApp.Workbooks.Add
lngRow = 1
On Error Resume Next
'Put out some column Headers
With wbExcel.Sheets(1)
.Range("A" & lngRow) = "Table"
.Range("B" & lngRow) = "FieldName"
.Range("C" & lngRow) = "FieldLen"
.Range("D" & lngRow) = "FieldType"
End With
Set ws = wbExcel.Sheets(1)
With ws.Range("A1:D1").Font
.Bold = True
.Name = "MS Sans Serif"
.Size = 8.5
End With
ws.Range("A1:D1").HorizontalAlignment = xlCenter
ws.Range("A1:D1").Interior.ColorIndex = 15
ws.Range("A1:D1").Borders(xlDiagonalDown).LineStyle = xlNone
ws.Range("A1:D1").Borders(xlDiagonalUp).LineStyle = xlNone
With ws.Range("A1:D1").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A1:D1").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A1:D1").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A1:D1").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A1:D1").Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

ws.Range("A2").Select
xlApp.Windows(1).FreezePanes = True

'Loop through all tables
For lngTable = 0 To db.TableDefs.Count
'Do nothing if temporary or system table
If Left(db.TableDefs(lngTable).Name, 1) = "~" Or _
Left(db.TableDefs(lngTable).Name, 4) = "MSYS" Then
Else
'Loop through each table, writing the table and field names
'to an Excel file
For lngField = 0 To db.TableDefs(lngTable).Fields.Count - 1
'For lngField = 0 To 2
lngRow = lngRow + 1
With wbExcel.Sheets(1)
.Range("A" & lngRow) = db.TableDefs(lngTable).Name
.Range("B" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Name
.Range("C" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Size
.Range("D" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Type
End With
Next lngField
lngRow = lngRow + 2
End If
Next lngTable
'Errors back in effect
On Error GoTo 0
ws.Columns("A:B").Select
ws.Columns("A:B").EntireColumn.AutoFit
'Set Excel to visible so user can save or let go
xlApp.Visible = True
Set xlApp = Nothing
Set wbExcel = Nothing
Set db = Nothing

End Sub
 
Back
Top