[AccessD] Excel Automation Question

Two questions here <g>.

1/ Setting the column width.

Here's a routine I use to format a range of columns so they fit the data in
them, and also it formats the column headers.

Sub FormatAndAutoFitHeaders(sFileName As String, nWkSheetNumber As Integer,
nLastColumn As Integer _
    , Optional nFirstColumn As Integer = 1, Optional nCellColor As Long =
vbYellow _
    , Optional nCellBorder As Long = vbBlack)
Dim xlFile As Excel.Application
Dim xlwb As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim oRng As Excel.Range

    Set xlFile = OpenXLWorkBookHidden(sFileName)
    With xlFile
        Set xlwb = xlFile.Workbooks(GetFileName(sFileName))
        Set xlSheet = xlwb.Worksheets(nWkSheetNumber)
        Set oRng = xlSheet.Range(xlSheet.Cells(1, nFirstColumn),
xlSheet.Cells(1, nLastColumn))
        oRng.EntireColumn.AutoFit
        oRng.Interior.Color = vbYellow
        oRng.Borders.Color = vbBlack
        Set oRng = Nothing
        Set xlSheet = Nothing
        Set xlwb = Nothing
    End With
    CloseXLWorkBook xlFile, True
End Sub

This uses three other routines.

Function OpenXLWorkBookHidden(Path As String, Optional UpdateLinks As
Boolean = False, Optional password As String = "") As Excel.Application
    Dim xlObj As Excel.Application
       
    On Error GoTo OpenXLWorkBookHidden_err
    'Check to see if the file name passed in to the procedure is valid
    If IsNull(Path) Or isDirectory(Path) Or Not FileExists(Path) Then
        MsgBox Path & " isn't a valid path!", vbCritical, "Open Excel
Workbook"
        Set OpenXLWorkBookHidden = Nothing
        Exit Function
    Else
        Set xlObj = CreateObject("Excel.Application")
    
        xlObj.Workbooks.Open Path, UpdateLinks, , , password
        Set OpenXLWorkBookHidden = xlObj
    End If
OpenXLWorkBookHidden_exit:
    Exit Function
OpenXLWorkBookHidden_err:
' call your own error reporting routine here.
'    ReportError Err.Number, Err.Description, "OpenXLWorkBookHidden",
"Excel_mod", "File Name=" & Path
    Set OpenXLWorkBookHidden = Nothing
    Resume OpenXLWorkBookHidden_exit
End Function

Sub CloseXLWorkBook(xlApp As Excel.Application, Optional bSaveChanges As
Boolean = False)
Dim wb As Excel.Workbook
    On Error Resume Next
    If xlApp.Name > "" Then
    End If
    If Err.Number <> 0 Then Exit Sub
    On Error GoTo 0
        For Each wb In xlApp.Workbooks         'Close all open workbooks
            wb.Close bSaveChanges
        Next wb
    xlApp.UserControl = False
    Set xlApp = Nothing
End Sub

and finally

Function GetFileName(aPath) As String
Dim fPath As String
    fPath = GetPath(aPath)
    If Len(fPath) = Len(aPath) Then ' only a path was provided
        GetFileName = ""
    Else
        GetFileName = Right$(aPath, Len(aPath) - Len(fPath))
    End If
End Function

which in turn uses...

Function GetPath(aPath) As String
' Strips the path name from the supplied file and path name
' leaves the trailing slash on there
Dim foo As Integer, aSlash As Integer
    aSlash = 0
    foo = InStr(aPath, "\")
    While (foo > 0)
        aSlash = foo
        foo = InStr(aSlash + 1, aPath, "\")
    Wend
    If aSlash > 0 Then
        GetPath = Left$(aPath, aSlash)
    Else
        GetPath = ""
    End If
End Function

as for setting the colum to Time format, simply recording a macro in Excel
reveals the code looks like this...

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 11/24/2003 by L Heenan
'

'
    Columns("A:A").Select
    Selection.NumberFormat = "h:mm:ss"
End Sub


HTH

Lambert

> -----Original Message-----
> From:	Dale Kalsow [SMTP:dkalsow at yahoo.com]
> Sent:	Monday, November 24, 2003 10:29 AM
> To:	Access Developers discussion and problem solving
> Subject:	[AccessD] Excel Automation Question
> 
> 
> Goood Morning Everyone,
> 
>  
> 
> I have an excel automation question.  I have Access XP and though vba I am
> writing to an excel spread sheet.  Does any know how to set the column
> width of a column in excel and then format that column for time.
> 
>  
> 
> Thanks in advance.
> 
>  
> 
> Dale
> 
> 
> 
> ---------------------------------
> Do you Yahoo!?
> Free Pop-Up Blocker - Get it now
> _______________________________________________
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com