Formatting Excel Spreadsheet

zooropa66

Registered User.
Local time
Today, 14:29
Joined
Nov 23, 2010
Messages
61
I've managed to transfer data in a subform frm_WIP_Subform to C:\MyWIP\WIP.xls using:


Code:
DoCmd.OutputTo acOutputForm, "frm_WIP_Subform", acFormatXLS, "C:\MyWIP\WIP.xls", True

and this works fine. The correct data is transferred and the spreadsheet opens.
However, I would like to apply some formatting

(1) make cell A1 bold
(2) change the worksheet name from frm_WIP_Subform to WIP

I've just spent 4 hours looking through various forums and tried different suggestions but i'm no further forward.

Can anyone help?
 
You can find an function here that would fit your needs. You may need to make some minor changes for your specific formatting requirements.
 
I had a problem with resetting my password so i had to set up a new login with a slightly different username but it's still zooropa66 here

Thanks for your reply. I tried putting the suggested code in a module called MyFunctions I've also made sure i'm referencing DAO. However, i can't see where i'd define the path to the spreadsheet (I'd like it to be C:\MyWIP\WIP.xls). When I click the button on my form i just get the following error "The expression on click you entered as the event property setting produced the following erros: Argument not optional"

Here is the code, the only slight difference is that i've added the line

strTQName = "qryWIP" which is the name of the query that produces the data i'd like to see in the spreadsheet

Code:
Public Function SendTQ2Excel(strTQName As String, Optional strSheetName As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to name it to
    
    strTQName = "qryWIP"
    
    
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    On Error GoTo err_handler
    Set rst = CurrentDb.OpenRecordset(strTQName)
    Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Add
    ApXL.Visible = True
        
    Set xlWSh = xlWBk.Worksheets("Sheet1")
    If Len(strSheetName) > 0 Then
        xlWSh.Name = Left(strSheetName, 34)
    End If

    xlWSh.Activate
    xlWSh.Range("A1").Select

    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
    ApXL.Selection.Font.Bold = True
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
    rst.Close
    Set rst = Nothing
    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function
End Function
 
It worked. All I had to do was declare strTQName As String as a Global variable. Thanks for the link Beetle and to Bob L and all MVP's for helping newbies like me
 
Can anyone suggest how i can modify the above code to

(1) insert two blank rows (rows 1 & 2) above the data sent from access to excel
(2) insert the date in cell A1
(3) make cells C2,C3,C4, ... vertically aligned

I've tried several things but no success. Many thanks.
 
(1) insert two blank rows (rows 1 & 2) above the data sent from access to excel

Modify the row at which the data starts, so this line;

xlWSh.Range("A2").CopyFromRecordset rst

would become;

xlWSh.Range("A4").CopyFromRecordset rst

(or A5, A6, etc. depending on where you want to start)

(2) insert the date in cell A1

This could be done with a code line like;

xlWSh.Range("A1") = Date()

(3) make cells C2,C3,C4, ... vertically aligned

Do you mean you want the values in the cells aligned left or right?
 
Thanks Beetle. By vertical alignment I mean I want to turn the text 90 degrees so its sitting vertically rather than horizontally
 
...I want to turn the text 90 degrees so its sitting vertically rather than horizontally

The code lines for that would look like;

xlWSh.Range("C1:C4").Select
ApXL.Selection.Orientation = -90


Modify the cells in the range to suit your needs.
 
Perfect! Perfect! Perfect! Worked Great! Thankyou so much Beetle.
 

Users who are viewing this thread

Back
Top Bottom