Formatting Excel with VBA

[ss6857]

Access to Excel Code Errors

Hello everyone. I've been reviewing threads and this one seems to be the one that most relates to my problem, but I couldn't exactly find the answer. I'm exporting a query I create in VB to Excel and then wish to format it. I first did the formatting in excel to make sure that It will actually work, but I keep getting errors about how the object isn't defined. And I've made a lot of changes because of all the information I have found so you'll probably find some things that are unnecessary.

Dim db As DAO.Database
Dim xlname As String
Dim qrypaste As DAO.Recordset
Dim xlapp As Object
Dim xlwb As Object
Dim xlsheet As Object
Dim lastrow As Long
Dim i As Integer
Dim vFilePath As String
Dim objname As String
 
vFilePath = "S:\Pricing\Pricing.WordDocs\"
objname = Me.Combo7.Text
xlname = Me.Combo7.Text & ".xlsx"
If Me.Check90 = True Then
    Set db = CurrentDb
    Set MyQry = db.CreateQueryDef("TempQry", "SELECT dbo_qry_MasterPriceTable.Name, dbo_qry_MasterPriceTable.Category, " & _
        "dbo_qry_MasterPriceTable.Product, dbo_qry_MasterPriceTable.ProductDesc As Description, dbo_qry_MasterPriceTable.Weight, " & _
        "dbo_qry_MasterPriceTable.Price, dbo_qry_MasterPriceTable.UnitPrice, dbo_qry_MasterPriceTable.Level_Desc As [Price Level] " & _
        "FROM dbo_qry_MasterPriceTable " & _
        "Where dbo_qry_MasterPriceTable.name =" & Chr(34) & objname & Chr(34) & " " & _
        "ORDER BY dbo_qry_MasterPriceTable.Category_ID, dbo_qry_MasterPriceTable.Num;")
 
    DoCmd.OpenQuery "TempQry", acViewNormal, acEdit
   [COLOR=seagreen]'If Me.Check84 = True Then[/COLOR]
        DoCmd.OutputTo acOutputQuery, "TempQry", ".xlsx", vFilePath & xlname, True, "", , acExportQualityPrint
[COLOR=seagreen]   'Else[/COLOR]
[COLOR=seagreen]       'DoCmd.OutputTo acOutputQuery, "TempQry", ".xlsx", vFilePath & xlname, False, "", , acExportQualityPrint[/COLOR]
[COLOR=seagreen]   'End If[/COLOR]
End If
[COLOR=seagreen]'Format[/COLOR]
Set xlapp = CreateObject("Excel.Application")
Set xlwb = xlapp.Workbooks.Open(vFilePath & xlname)
xlapp.enableEvents = False
Set xlsheet = xlwb.Sheets("TempQry")
xlsheet.Activate
With xlsheet.Application
    .Cells.Select
    .Selection.WrapText = False
    .Cells.EntireColumn.AutoFit
 
    .Rows("1:1").Select
    .Selection.Insert Shift:=xlDown
 
    .Range("A3").Select
    .Selection.Copy
    .Range("B1").Select
    .ActiveSheet.Paste
    .Selection.Font.Size = 16
 
    .Columns("A:A").Select
    .Selection.Delete Shift:=xlToLeft
    .Selection.ColumnWidth = 14
    .Selection.Font.Bold = True
 
End With
    With xlsheet.Application.Range("A:A")
    For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1 [COLOR=red]<--Application -defined or object-defined error 1004 or Object Required[/COLOR]
        If .Cells(i, 1) = .Cells(i - 1, 1) Then .Cells(i, 1).ClearContents
    Next i
    End With
 
[COLOR=seagreen]'Insert Rows[/COLOR]
With xlapp.Application.Range("A:A")
    For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 4 Step -1
        If .Cells(i, 1) <> "" Then
        .Rows(i).EntireRow.Insert
        .Rows(i).EntireRow.Insert
        End If
    Next i
End With
lastrow = xlapp.Application.Range("G65536").End(xlUp).Row
With xlapp.Application
    .Range("B3:G" & lastrow & "").Select
        .Selection.Cut
        .Range("B4").Select
        .ActiveSheet.Paste
 
    .ActiveWorkbook.Save
    .ActiveWorkbook.Close
 
End With
xlapp.Quit
    DoCmd.Close acQuery, "TempQry", acSaveNo
    DoCmd.DeleteObject acQuery, "TempQry"

Also, When I run this (it runs off of a command button) it opens the excel file without showing any of the formatting. Then I click out of excel and do something things.. Then a message box pops up and says "file now available" and when I open it it shows the excel with all the formatting up to where I get an error.

Thanks for any and all help

Hi, I posted in another thread, but I didn't get any response.. I'm hoping maybe this one will help. I am also trying to tie the excel code back to access and it is not working for me. Please take a look and see where I've gone wrong

Dim vFilePath As String
Dim objname As String
Dim db As DAO.Database
Dim xlname As String
Dim xlapp As Object
Dim xlwb As Object
Dim xlsheet As Object
Dim lastrow As Long
Dim i As Integer
 
vFilePath = "S:\Pricing\WordDocs\"
objname = Me.Combo7.Text
xlname = Me.Combo7.Text & ".xlsx"
If Me.Check90 = True Then
    Set db = CurrentDb
    Set MyQry = db.CreateQueryDef("TempQry", "SELECT dbo_qry_MasterPriceTable.Name, dbo_qry_MasterPriceTable.Category, " & _
        "dbo_qry_MasterPriceTable.Product, dbo_qry_MasterPriceTable.ProductDesc As Description, dbo_qry_MasterPriceTable.Weight, " & _
        "dbo_qry_MasterPriceTable.Price, dbo_qry_MasterPriceTable.UnitPrice, dbo_qry_MasterPriceTable.Level_Desc As [Price Level] " & _
        "FROM dbo_qry_MasterPriceTable " & _
        "Where dbo_qry_MasterPriceTable.name =" & Chr(34) & objname & Chr(34) & " " & _
        "ORDER BY dbo_qry_MasterPriceTable.Category_ID, dbo_qry_MasterPriceTable.Num;")
 
    DoCmd.OpenQuery "TempQry", acViewNormal, acEdit
    DoCmd.OutputTo acOutputQuery, "TempQry", ".xlsx", vFilePath & xlname, True, "", , acExportQualityPrint
 
End If
 
 
Set xlapp = CreateObject("Excel.Application")
Set xlwb = Excel.ActiveWorkbook
Set xlsheet = Excel.ActiveSheet
 
With xlapp.xlsheet.Application [COLOR=red]<-- Where the trouble begins. I have tried a number of different combinations including xlapp.xlwb.xlsheet, xlapp.Application.xlwb.xlsheet, xlwb.xlsheet, xlsheet...[/COLOR]
[COLOR=black]   .Cells.Select[/COLOR]
    .Selection.WrapText = False
    .Cells.EntireColumn.AutoFit
 
    .Rows("1:1").Select
    .Selection.Insert Shift:=xlDown
    .Range("A3").Select
    .Selection.Copy
    .Range("B1").Select
    .ActiveSheet.Paste
    .Selection.Font.Size = 16
 
    .Columns("A:A").Select
    .Selection.Delete Shift:=xlToLeft
    .Selection.ColumnWidth = 14
    .Selection.Font.Bold = True
 
End With
    With xlsheet.Application.Range("A:A")
    For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If .Cells(i, 1) = .Cells(i - 1, 1) Then .Cells(i, 1).ClearContents
    Next i
    End With
End sub

 

[boblarson]

This:

With xlapp.xlsheet.Application

Should be

With xlapp