Fordraiders
asked on
rying to make a column a certain width when exporting to excel from access
access 365
excel 365
Trying to make a column a certain width.
Keep getting ERROR object variable not correct ?
tryying to use this in the code below
function:
excel 365
Trying to make a column a certain width.
Keep getting ERROR object variable not correct ?
tryying to use this in the code below
' Column width adjustments
With .Cells(1, 1)
.EntireColumn.ColumnWidth = 15.29
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
function:
Function Export( _
query$, path$, _
fileName$, wksName$, _
colsCurrency$, colsDate$ _
) As String
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
On Error GoTo errHandler
Dim xlApp As Object, wkbk As Object, wks As Object
Dim file$
Dim formatCur$, formatDate$, intColor&
Dim arrayCols() As String, col$, n%, i%, w!
Dim cell As Range
Dim msg$
' Worksheet formats
formatCur$ = "$#,##0_);($#,##0)"
formatDate$ = "dd-mm-yyyy"
intColor& = RGB(192, 192, 192)
' Create workbook
file$ = path$ & fileName$
DoCmd.TransferSpreadsheet _
TransferType:=acExport, _
SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:=query$, _
fileName:=file$, _
HasFieldNames:=True
' Open workbook
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
Set wkbk = .Workbooks.Open(file$)
End With
' Format worksheet
Set wks = wkbk.worksheets(1)
With wks
.Name = wksName$
' Currency columns
arrayCols = Split(colsCurrency$, ",")
For i = LBound(arrayCols) To UBound(arrayCols)
With .Columns(arrayCols(i))
.NumberFormat = "$#,##0_);($#,##0)"
End With
Next i
' Date columns
arrayCols = Split(colsDate$, ",")
For i = LBound(arrayCols) To UBound(arrayCols)
With .Columns(arrayCols(i))
.NumberFormat = formatDate$
End With
Next i
' Filters
' With .Range("A1")
' .Select
' .autofilter
' End With
.Columns("U:V").Cut
.Columns("C:C").Insert Shift:=xlToRight
.Columns("V:V").Cut
.Columns("I:I").Insert Shift:=xlToRight
.Columns("A:A").Cut
.Columns("Y:Y").Insert Shift:=xlToRight
.Columns("T:T").Cut
.Columns("N:N").Insert Shift:=xlToRight
.Columns("V:V").Cut
.Columns("O:O").Insert Shift:=xlToRight
.Columns("W:W").Cut
.Columns("P:P").Insert Shift:=xlToRight
.Columns("W:W").Delete
' Column O gets renamed to "Rebate or Incentive End Date"
With .Range("O1")
.Select
ActiveCell.FormulaR1C1 = "Rebate or Incentive End Date"
End With
' Column width adjustments < ------------- ERROR HERE ?
With .Cells(1, 1)
.EntireColumn.ColumnWidth = 15.29
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' With .Cells
' .Select
' .EntireColumn.AutoFit
' End With
n% = .Cells(1, 1).End(xlToRight).Column
For i% = 1 To n%
With .Cells(1, i%)
' w! = .EntireColumn.ColumnWidth
' .EntireColumn.ColumnWidth = w! + 4
.HorizontalAlignment = xlCenter
.Interior.Color = intColor&
.Font.Bold = True
End With
Next i%
End With
' FREEZE PANES
With xlApp.ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With
msg$ = vbNullString
procDone:
Set wks = Nothing
Set wkbk = Nothing
Set xlApp = Nothing
dmwExport = msg$
Exit Function
errHandler:
msg$ = _
Err.Number & ": " & Err.Description
Resume procDone
End Function
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Check what i wrote...replace the constants with the values
ASKER
thanks john
ASKER
With .Cells(1, 1)
.EntireColumn.ColumnWidth = 15.29
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With