asked on

Formatting Excel from Access with VBA...

Here's what I am trying to accomplish:
From Access, I have vba code to copy records from a form and open Excel and paste records. The Access datasheet columns can be hidden / displayed by the user with checkboxes. I want the exported product in Excel to contain the same columns that are displayed on the form (This will vary depending on what the user selects). The acOutputForm option only exports all columns. I'm sure there is probably a better way to do this...I am stuck on the formatting of Excel cells with a border. Trying to use UsedRange, but it isn't working.

This is what I need help with:
1. Applying borders to the UsedRange of cells in the Exported Excel file. Would be even better if the code could shade (light gray), bold and border the 1st row of column header cells.

2. Clearing the Clipboard afterwards.

Here's the code -

Private Sub cmd_expExcel_Click()
Dim xlapp As Excel.Application

On Error GoTo cmd_expExcel_Click_Err
Me.frm_qcls_ttr.SetFocus
DoCmd.RunCommand acCmdSelectAllRecords
DoCmd.RunCommand acCmdCopy

Set xlapp = CreateObject("Excel.Application")

With xlapp
    .Workbooks.Add
    .ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
    .Cells.Select
    .Cells.EntireColumn.AutoFit
    .Visible = True
    
    .Range("A1:L1").Select
    .Selection.Font.Bold = True
    .Range("A1").Select
End With

'Can't get border added on used range. This range will change depending on how many columns are selected on the form and how records exist.
'Need help with this part; this works as an Excel Macro, but doesn't work from Access. [embed=file 1153580][embed=file 1153581]
'Throwing Error message with the Border Code below "Object doesn't Support this Object or Method"
'With xlapp
'    .ActiveSheet.UsedRange.Borders
'    .LineStyle = xlContinuous
'    .Weight = xlHairline
'    .ColorIndex = xlAutomatic
'End With

DoCmd.GoToControl "cmd_expExcel"

'Also need help with clearing the clipboard

Set xlapp = Nothing

cmd_expExcel_click_Exit:
Exit Sub
cmd_expExcel_Click_Err:
MsgBox Error$
Resume cmd_expExcel_click_Exit

End Sub

Open in new window

Sample-Database.mdb
Sample-Excel-File.xlsx

ASKER CERTIFIED SOLUTION

Norie

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

BSA2010

ASKER

Yes, this is great. Figured out what I was doing wrong and was able to apply the shading and thicker border to the first row. Thank you.

Any idea on clearing the clipboard?

Rgonzo1971

Hi,

pls try

xlapp .CutCopyMode = False

Open in new window

Regards

BSA2010

ASKER

Here's what my final code looks like for reference to others:

Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongLong) As LongLong
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongLong
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As LongLong
'These do not work in 32 bit systems
'Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
'Public Declare Function EmptyClipboard Lib "user32" () As Long
'Public Declare Function CloseClipboard Lib "user32" () As Long

Sub ClearClipboard()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Sub

Private Sub cmd_expExcel_Click()
Dim xlapp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet
Dim xlRng As Excel.Range

    'On Error GoTo cmd_expExcel_Click_Err
    Me.frm_qcls_ttr.SetFocus
    DoCmd.RunCommand acCmdSelectAllRecords
    DoCmd.RunCommand acCmdCopy

    Set xlapp = CreateObject("Excel.Application")

    Set xlWB = xlapp.Workbooks.Add
    Set xlWS = xlWB.ActiveSheet

    xlWS.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False

    Set xlRng = xlWS.UsedRange

    xlRng.EntireColumn.AutoFit

    xlRng.Rows(1).Font.Bold = True
    
    With xlRng.Borders
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With

    With xlRng.Rows(1).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    
    With xlRng.Rows(1).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.14996795556505
        .PatternTintAndShade = 0
    End With

    xlRng.Range("A1").Select
    
    DoCmd.GoToControl "cmd_expExcel"

    'Also need help with clearing the clipboard

    xlapp.Visible = True
    
    Set xlapp = Nothing
    Call ClearClipboard
    
cmd_expExcel_click_Exit:
    Exit Sub
cmd_expExcel_Click_Err:
    MsgBox Error$
    Resume cmd_expExcel_click_Exit

End Sub

Open in new window

BSA2010

ASKER

Thank you Norie! Your code helped me resolve the issues. Appreciate it. Have a great day!