Link to home
Start Free TrialLog in
Avatar of Fordraiders
FordraidersFlag for United States of America

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
   ' 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
    
       
      

Open in new window



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

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of John Tsioumpris
John Tsioumpris
Flag of Greece image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Fordraiders

ASKER

' 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
Check what i wrote...replace the constants with the values
thanks  john