using vba from Access to change Excel worksheet

Q

qwertyjjj

Registered User.
Local time
Yesterday, 19:50
Joined
Aug 8, 2006
Messages
262
Hi
I create an Excel workbook from Access and this contains some exported data. I am then trying to change various cells in the worksheet so that it is essentially a finished product. I am doing this by recording a macro and then using some of that code in Access.
This is Access 2003 and Excel 2003.
The problem is that the code created by the macro is not recognised by Access and I cannot understand why as it is all essentially VBA.

Some code below:
' Open an existing spreadsheet
Call Shell("C:\Program Files\Microsoft Office\Office11\excel.EXE " & "C:\A.xls", 1)
Set appExcel = CreateObject("C:\A.xls")
Set workSheet = appExcel.Worksheets("A")

' Show spreadsheet on screen
appExcel.Application.Visible = True
appExcel.Parent.Windows(1).Visible = True

With workSheet
.Range("A30").Value = "1"
.Range("A30").Copy
.Range("B2:BI13").Select
.Range("B2:BI13").PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False
.Range("A30").ClearContents
'.Range("P:BJ").Delete Shift:=xlToLeft
.Range("B1").Value = "Company Code"
.Range("L1").Value = "DD"
.Range("M1").Value = "DD-1"
.Range("N1").Value = "DD-2"
.Range("O1").Value = "DD-3"

.Range("B13").Select
.Selection.Copy
.Range("B14").Select
.ActiveSheet.Paste
End With

The debugger highlights this line:
.Selection.Copy

and the error is object doesn't support this property or method.

I have got round this by doing things like .Range("B13").Copy, etc. but would ideally just like to paste the macro entirely.

ANy ideas on what is wrong?
 
Last edited:
Hello,

you can't use .Selection.Copy from Access as you are really Selecting the Cells. you could do with tidying up the code too, comments below your code:



Code: 
Call Shell("C:\Program Files\Microsoft Office\Office11\excel.EXE " & "C:\A.xls", 1)
Set appExcel = CreateObject("C:\A.xls")
Set workSheet = appExcel.Worksheets("A")

Remove and add:
Code: 
[COLOR="blue"]Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlSheet As Excel.Worksheet    
Set xlApp = New Excel.Application
Set xlWB = xlApp.Workbooks.Open("C:\A.xls")[/COLOR]

'Show spreadsheet on screen
Code: 
appExcel.Application.Visible = True
appExcel.Parent.Windows(1).Visible = True
I don't think you need to, there isn't a programming need anyway


Code: 
With workSheet
.Range("A30").Value = "1"
.Range("A30").Copy
.Range("B2:BI13").Select
.Range("B2:BI13").PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False
.Range("A30").ClearContents
This looks like you are trying to place '1' into B2:BI13
Use:

Code: 
[COLOR="Blue"]
With xlWB.Sheets("A")

.Range("B2:BI13") = 1[/COLOR]


Code: 
'.Range("P:BJ").Delete Shift:=xlToLeft
Not sure why you deleted the cells, if you went too far when redording it change above to:

Code: 
[COLOR="Blue"].Range("B2:O13") = 1[/COLOR]

Code: 
.Range("B1").Value = "Company Code"
.Range("L1").Value = "DD"
.Range("M1").Value = "DD-1"
.Range("N1").Value = "DD-2"
.Range("O1").Value = "DD-3"
Is all good

Now your sticky bit
Code: 
.Range("B13").Select
.Selection.Copy
.Range("B14").Select
.ActiveSheet.Paste
Change to:

Code: 
[COLOR="blue"].Range("B13").Copy
.Range("B14").PasteSpecial Paste:=xlPasteAll[/COLOR]

Or:

Code: 
[COLOR="blue"].Range("B14") = Range("B13")[/COLOR]
As long as there isn't a formula in there

Code: 
End With
Fine

So your final code should be:

Code: 
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlSheet As Excel.Worksheet    
Set xlApp = New Excel.Application
Set xlWB = xlApp.Workbooks.Open("C:\A.xls")

With xlWB.Sheets("A")

.Range("B2:BI13") = 1

.Range("B13").Copy
.Range("B14").PasteSpecial Paste:=xlPasteAll

End With

Set xlWB = Nothing
Set xlApp = Nothing

Don't shoot me if it doesn't work 1st time, I'm rebuilding my PC can't test it.
But hopefully you can see the methids I've used.

Basically, don't use Activate or Sellect in your code, what's the point you don't need to se the cells being changed, they just need changing.
Good example here is

Range("A1").Select
Range("A1").Copy

Imagine if you wanted to copy this from a hidden sheet, you couldn't! not without unhiding to select. The good news...

Range("A1").Copy
Works AND is faster.

BTW the link in ghudson's post I don't rate personally, that's my opinion.

It uses:

With xlApp
.Application.Sheets("YourSheetName").Select
.Application.Cells.Select
.Application.Selection.ClearFormats

When

With xlApp.Application
.Sheets("YourSheetName").Cells.ClearFormats

Is better and faster.
The link also suggest using Sheet(1) as a reference, I would only use this if I knew for sure 1 was the sheet I wanted.

Anyway hope that helps.
And finally, take a look at:

http://www.tushar-mehta.com/excel/vba/xl_doesnt_quit/

You will be needing this if you are manipulating Excel from Access and that's a promise.

Cheers,
 
Thanks for that.
I have tidied up the code. However, as suggested I am now having problems with getting Excel to quit.
If I close down Excel manually from Excel, it still stays in the taskbar.
I cannot find any global references in the code...unless I'm misunderstanding the scope.

Any ideas?

Private Sub Command264_Click()

'On Error GoTo Err_ModifyExportedExcelFileFormats

Application.SetOption "Show Status Bar", True
vStatusBar = SysCmd(acSysCmdSetStatus, "Formatting export file... please wait.")

DoCmd.OutputTo acOutputForm, "A", acFormatXLS, "C:\A.xls", False

Dim xlApp As Excel.Application
Dim xlWB As Excel.workBook
Dim xlSheet As Excel.workSheet
Set xlApp = New Excel.Application
Set xlWB = xlApp.Workbooks.Open("C:\A.xls")

Dim dbs As DAO.Database
Dim rst As DAO.Recordset

Const cStartRow As Byte = 18
Const cStartColumn As Byte = 1

With xlWB.Sheets(1)
.Range("A30").Value = "1"
.Range("A30").Copy
.Range("B2:BI13").PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False
.Range("A30").ClearContents
.Range("B1").Value = "Company Code"
.Range("L1").Value = "DD"
.Range("M1").Value = "DD-1"
.Range("N1").Value = "DD-2"
.Range("O1").Value = "DD-3"
End With

'put in the top 10 data
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Query1", dbOpenSnapshot)
iCol = cStartColumn
iRow = cStartRow
If Not rst.BOF Then rst.MoveFirst
Do Until rst.EOF
iFld = 0

For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
xlWB.Sheets(1).Cells(iRow, iCol) = rst.Fields(iFld)

xlWB.Sheets(1).Cells(iRow, iCol).WrapText = False
iFld = iFld + 1
Next

iRow = iRow + 1
rst.MoveNext
Loop

'now put in all the headers and other stuff
With xlWB.Sheets(1)
.Rows("1:1").Insert Shift:=xlDown
.Rows("1:1").Insert Shift:=xlDown
.Rows("1:1").Insert Shift:=xlDown
.Rows("1:1").Insert Shift:=xlDown
.Range("A3").FormulaR1C1 = "(1) Debt Summary (£ 000's)"
.Range("A3").Font.Underline = xlUnderlineStyleSingle
.Range("A19").FormulaR1C1 = "Totals"
.Range("A20").FormulaR1C1 = "Totals Last Month"
.Range("A21").FormulaR1C1 = "Variance"
.Rows("22:22").Insert Shift:=xlDown
.Rows("22:22").Insert Shift:=xlDown
.Rows("22:22").Insert Shift:=xlDown
.Rows("22:22").Insert Shift:=xlDown
.Rows("22:22").Insert Shift:=xlDown
.Rows("22:22").Insert Shift:=xlDown
.Rows("22:22").Insert Shift:=xlDown
.Rows("22:22").Insert Shift:=xlDown
.Rows("22:22").Insert Shift:=xlDown
.Rows("22:22").Insert Shift:=xlDown
.Range("A23").FormulaR1C1 = "(2) Percentage Ageing"
.Range("A23").Font.Underline = xlUnderlineStyleSingle
.Range("A25").FormulaR1C1 = "Current Month"
.Range("A26").FormulaR1C1 = "Ageing Last Month"
.Range("A27").FormulaR1C1 = "Variance"
.Range("A30").FormulaR1C1 = "(3) Top 10 Bad Debt Provisions"
.Range("A30").Font.Underline = xlUnderlineStyleSingle

.Range("P6").Copy
.Range("C19").PasteSpecial Paste:=xlPasteAll
.Range("AG6:AL6").Copy
.Range("D19").PasteSpecial Paste:=xlPasteAll
.Range("AZ6").Copy
.Range("J19").PasteSpecial Paste:=xlPasteAll
.Range("BC6").Copy
.Range("K19").PasteSpecial Paste:=xlPasteAll
.Range("BF6:BI6").Copy
.Range("L19").PasteSpecial Paste:=xlPasteAll
.Range("AM6:AS6").Copy
.Range("C20").PasteSpecial Paste:=xlPasteAll
.Range("BA6").Copy
.Range("J20").PasteSpecial Paste:=xlPasteAll
.Range("BD6").Copy
.Range("K20").PasteSpecial Paste:=xlPasteAll
.Range("C21").FormulaR1C1 = "=R[-2]C-R[-1]C"
.Range("C21").AutoFill Destination:=Range("C21:K21"), Type:=xlFillDefault
.Range("A19:O21").Font.Bold = True

'ageing analysis
.Range("C25").FormulaR1C1 = "=ROUND((R[-6]C/R19C7)*100,0)"
.Range("C26").FormulaR1C1 = "=ROUND((R[-6]C/R20C7)*100,0)"
.Range("C27").FormulaR1C1 = "=R[-2]C-R[-1]C"
.Range("C25:C27").AutoFill Destination:=Range("C25:F27"), Type:=xlFillDefault

'title header for section 3
.Rows("31:31").Insert Shift:=xlDown
.Range("A32").FormulaR1C1 = "Customer"
.Range("C32").FormulaR1C1 = "'0-3"
.Range("D32").FormulaR1C1 = "'4-5"
.Range("E32").FormulaR1C1 = "'6-12"
.Range("F32").FormulaR1C1 = "'>12"
.Range("G32").FormulaR1C1 = "Total Debt"
.Range("H32").FormulaR1C1 = "Bad Debt"
.Range("I32").FormulaR1C1 = "Remedial action"
.Range("J32").FormulaR1C1 = "Responsible For"
.Range("A32:J32").Interior.ColorIndex = 15
.Range("A32:J32").Interior.Pattern = xlSolid
.Range("C32:H32").HorizontalAlignment = xlCenter
End With

With xlWB.Sheets(1)
.Columns("P:BJ").Delete Shift:=xlToLeft

.Columns("A:A").WrapText = False
.Cells.EntireColumn.AutoFit
.Cells.EntireRow.AutoFit
.Cells.Font.Name = "Arial"
.Cells.Font.Size = 10
.Cells.Borders(xlDiagonalDown).LineStyle = xlNone
.Cells.Borders(xlDiagonalUp).LineStyle = xlNone
.Cells.Borders(xlEdgeLeft).LineStyle = xlNone
.Cells.Borders(xlEdgeTop).LineStyle = xlNone
.Cells.Borders(xlEdgeBottom).LineStyle = xlNone
.Cells.Borders(xlEdgeRight).LineStyle = xlNone
.Cells.Borders(xlInsideVertical).LineStyle = xlNone
.Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
.Range("A1").Select
End With

xlApp.Visible = True

Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
Set rst = Nothing
Set dbs = Nothing

vStatusBar = SysCmd(acSysCmdClearStatus)

Exit_ModifyExportedExcelFileFormats:
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
Set rst = Nothing
Set dbs = Nothing
Exit Sub

Err_ModifyExportedExcelFileFormats:
vStatusBar = SysCmd(acSysCmdClearStatus)
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ModifyExportedExcelFileFormats
End Sub
 
It's okay. It's this:

.Range("C25:C27").AutoFill Destination:=Range("C25:F27"), Type:=xlFillDefault

changed to:

.Range("C25:C27").AutoFill Destination:=xlWB.Sheets(1).Range("C25:F27"), Type:=xlFillDefault
 
You must log in or register to reply here.

Similar threads

K
How to link to an Excel named range using vba
Replies
9
Views
931
Isaac
Isaac
H
How to insert some data from Excel spreadsheet and the other data from Access combo boxes
Replies
6
Views
517
Pat Hartman
P
L
Retrieve excel from access (vol 4) , extended format , alternative color
Replies
7
Views
901
arnelgp
arnelgp
C
Solved i want to change this code to merge two excel files to one sheet side by side.
Replies
2
Views
549
camiramzi
C
R
Updating Excel spreadsheet from within the Access
Replies
8
Views
1,380
CJ_London
C

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom