EXPORT MSACCESS -> MSEXCEL

[Pascale Breton]

Hello experts!


I am needing advices because I am capable to export data and all formats
from a query done in MsAccess to MsExcel except for the line format. Could
you please take a look to my code and tell me what could be wrong (the stars
are delimiting the part corresponding to the formatting). Thanks a lot to you
guys!

Pascale for Carolina

Option Compare Database

Private Sub Command0_Click()
Dim strSQL As String
Dim cn As Object
Dim rst As Object
Dim qdfTemp As Object
Dim db As Object
Dim obj As AccessObject
Dim dbs As Object
Const lngBackColor As Long = 16


tdate = Format(Now(), "YYMMDD hhmm")


Set cn = Application.CurrentProject.Connection
Set db = Application.CurrentProject



strSQL = "SELECT FinalBom.Level, FinalBom.[Item Number], FinalBom.Qty,
FinalBom.[Ref Des], FinalBom.[Item Description], IIf([AgileItemNumber] Is
Null,""Deleted"",IIf([Item Number]<>[AgileItemNumber],""Repleced"",IIf([Item
Number]=[AgileItemNumber],IIf([Qty]<>[AgileQty],IIf([Qty]>[AgileQty],""Qty
Decreased"",IIf([Qty]<[AgileQty],""Qty Increased"",""."")),IIf([Ref
Des]<>[AgileRefDes],""Location Changed"",""."")),""New""))) AS Action,
FinalBom.AgileLevel, FinalBom.AgileItemNumber, FinalBom.AgileQty,
FinalBom.AgileRefDes, FinalBom.AgileItemDescription" & _
" FROM FinalBom" & _
" ORDER BY FinalBom.Level;"

DoCmd.SetWarnings off
Set dbs = Application.CurrentData

For Each obj In dbs.AllQueries

'MsgBox obj.FullName
If obj.Name = "DS" Then
' Print name of obj.
DoCmd.DeleteObject acQuery, "DS"
Exit For
End If
Next obj

Set qdfTemp = Application.CurrentDb.CreateQueryDef("DS", strSQL)

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "DS",
"C:\Bom_Compairaison " & tdate, (-1)
DoCmd.DeleteObject acQuery, "DS"

Set MyExcel = CreateObject("Excel.Application")
MyExcel.Workbooks.Open "C:\Bom_Compairaison " & tdate
MyExcel.Visible = True
DoCmd.Close acForm, "F_BomComparaison", acSaveNo


MyExcel.Cells.select

MyExcel.ActiveWindow.Zoom = 85
MyExcel.Range("G2").select
MyExcel.ActiveWindow.FreezePanes = True

Selection = MyExcel.Range("G1").select
ln = 1
Do Until Trim(MyExcel.Cells(ln, 6).Value) = ""
ln = ln + 1
Loop

'*********************************************************************
myRange = "A1:" & "K" & ln
MyExcel.Range(myRange).select
MyExcel.activecell.Borders.LineStyle = xlContinuous
MyExcel.Cells.Borders.LineStyle = xlContinuous

'*********************************************************************
'Formatage des titres
ln = 1
cl = 1
Do Until Trim(MyExcel.Cells(ln, cl).Value) = ""
MyExcel.Cells(ln, cl).select
MyExcel.activecell.Font.Bold = True
MyExcel.activecell.interior.ColorIndex = 6
cl = cl + 1
Loop

ligne = 2



Do Until Trim(MyExcel.Range("F" + Trim(ligne)).Value) = ""
If Trim(MyExcel.Range("F" + Trim(ligne)).Value) <> "." Then
myRange = "A" & ligne & ":" & "K" & ligne
MyExcel.Range(myRange).select
MyExcel.Selection.interior.ColorIndex = 8
Else
MyExcel.Range("F" + Trim(ligne)).Value = ""

End If
ligne = ligne + 1
Loop
MyExcel.Cells.EntireColumn.AutoFit
End Sub