Access 2003 to Excel 2003 Q's

[bhikku]

Hello!

I have a form which uses the .copyfromrecordset method to populate a set of
rows in an Excel template from a query. Then the Excel template is saved as
a new .xls file.

Two issues:

1) After the Excel template is populated and saved as a new file, when you
subsequently open the new file the workbook is hidden. How do I make the
workbook visible after the data is inserted into the Excel file?

2) Within the rows I'm populating with the .copyfromrecordset method I need
one of the cells in each row to contain a simple formula. I tried faking
Excel and sending the string "=H9*I9" into one of the cells but that just
came over as text. Is there a way to programmatically apply a formula to a
cell in an Excel worksheet from Access? And, can it be done to a range of
cells?

I'll post code if needed.

b

 

[Jeanette Cunningham]

Hi,
Question 1, here is some code that will copy from recordset to a template
spreadsheet without hiding the new .xls file
Question 2 - I haven't answered

'------------------------
'replace the following with your own strings
'strDocPath = "c:\documents and settings\Jeanette\desktop\TemplateB.xls"
'strPath = "c:\documents and settings\Jeanette\desktop\Text.xls"
'strFirstCell = "A5"
'strWsName = "Sheet1"
'strSQL can be a saved query,
'or a saved table,
'or a sql statement
'strSql = "SELECT yadda, yadda " _
' & "FROM yadda " _
' & "WHERE yadda " _
' & "ORDER BY yadda"
'if your template has more than 1 worksheet
'you can choose which worksheet will receive the data
'you can choose which cell to start copying the data to
'------------------------
Public Sub CopyRecordset2XLTemplate()
On Error GoTo SubErr
Dim objXLApp As Object 'Excel.Application
Dim objXLWs As Object 'Excel.Worksheet
Dim strWsName As String 'name of worksheet
Dim strFirstCell As String 'starting point to add the data
Dim rst As DAO.Recordset
Dim strDocPath 'full path and name of template
Dim strPath As String 'full path and name to save file as
Dim strSQL As String 'data to export, table, query or sql statement


Const xlCellTypeLastCell = 11
Const xlContinuous = 1
Const xlAutomatic = -4105


'strDocPath = "c:\documents and settings\Jeanette\desktop\TemplateB.xls"
'strPath = "c:\documents and settings\Jeanette\desktop\Text.xls"
'strFirstCell = "A5"
'strWsName = "Sheet1"
'strSQL = "QueryName"

strDocPath = "c:\documents and
settings\jc.ECJ-02.000\desktop\MyPersonxpt.xls"
strPath = "c:\documents and
settings\jc.ECJ-02.000\desktop\MyNewPersonxpt.xls"

strWsName = "S1"
'name of the recordset to copy
strSQL = "qryNewStatusExport"
strFirstCell = "A4"


'replace with names and cell references that suit your template

' Populate the excel object
Set objXLApp = CreateObject("Excel.Application")
' Open the template workbook
objXLApp.Workbooks.Open (strDocPath)
' Save the template as the file specified by the user
objXLApp.ActiveWorkbook.SaveAs (strPath)

'Open a recordset on the table with query and worksheet names
Set rst = CurrentDb.OpenRecordset(strSQL)
If rst.EOF Then
'handle error here
Else
' Select the appropriate worksheet
Set objXLWs = objXLApp.ActiveWorkbook.Worksheets(strWsName)
' Activate the selected worksheet
objXLWs.Activate
' Ask Excel to copy the data from the recordset starting with
strFirstCell
objXLWs.Range(strFirstCell).CopyFromRecordset rst

' Select the main worksheet
objXLApp.Worksheets(strWsName).Activate
' Activate the selected worksheet
Set objXLWs = objXLApp.ActiveWorkbook.Worksheets(strWsName)
'format cells
With objXLWs.Cells
.Range(.Cells(1, 1), .Cells(1, _
1).SpecialCells(xlCellTypeLastCell)).Borders.LineStyle = _
xlContinuous
.Range(.Cells(1, 1), .Cells(1, _
1).SpecialCells(xlCellTypeLastCell)).Borders.ColorIndex = _
xlAutomatic
.Font.Size = 9
.Font.Name = "Arial Narrow"
.WrapText = True

End With

End If


'**error handling, in the Sub exit - make sure you set the object
'references to nothing as shown below.

SubExit:
' Save the workbook
objXLApp.ActiveWorkbook.Save
Set objXLWs = Nothing
Set objXLApp = Nothing
' Destroy the recordset and database objects
rst.Close
If Not rst Is Nothing Then
Set rst = Nothing
End If

Exit Sub

SubErr:
MsgBox Err.Description & " " & Err.Number
Resume SubExit
End Sub


Jeanette Cunningham

 

[bhikku]

Thank you, Jeanette! I'll give this a try.

b

Hi,
Question 1, here is some code that will copy from recordset to a template
spreadsheet without hiding the new .xls file
Question 2 - I haven't answered

'------------------------
'replace the following with your own strings
'strDocPath = "c:\documents and settings\Jeanette\desktop\TemplateB.xls"
'strPath = "c:\documents and settings\Jeanette\desktop\Text.xls"
'strFirstCell = "A5"
'strWsName = "Sheet1"
'strSQL can be a saved query,
'or a saved table,
'or a sql statement
'strSql = "SELECT yadda, yadda " _
' & "FROM yadda " _
' & "WHERE yadda " _
' & "ORDER BY yadda"
'if your template has more than 1 worksheet
'you can choose which worksheet will receive the data
'you can choose which cell to start copying the data to
'------------------------
Public Sub CopyRecordset2XLTemplate()
On Error GoTo SubErr
Dim objXLApp As Object 'Excel.Application
Dim objXLWs As Object 'Excel.Worksheet
Dim strWsName As String 'name of worksheet
Dim strFirstCell As String 'starting point to add the data
Dim rst As DAO.Recordset
Dim strDocPath 'full path and name of template
Dim strPath As String 'full path and name to save file as
Dim strSQL As String 'data to export, table, query or sql statement


Const xlCellTypeLastCell = 11
Const xlContinuous = 1
Const xlAutomatic = -4105


'strDocPath = "c:\documents and settings\Jeanette\desktop\TemplateB.xls"
'strPath = "c:\documents and settings\Jeanette\desktop\Text.xls"
'strFirstCell = "A5"
'strWsName = "Sheet1"
'strSQL = "QueryName"

strDocPath = "c:\documents and
settings\jc.ECJ-02.000\desktop\MyPersonxpt.xls"
strPath = "c:\documents and
settings\jc.ECJ-02.000\desktop\MyNewPersonxpt.xls"

strWsName = "S1"
'name of the recordset to copy
strSQL = "qryNewStatusExport"
strFirstCell = "A4"


'replace with names and cell references that suit your template

' Populate the excel object
Set objXLApp = CreateObject("Excel.Application")
' Open the template workbook
objXLApp.Workbooks.Open (strDocPath)
' Save the template as the file specified by the user
objXLApp.ActiveWorkbook.SaveAs (strPath)

'Open a recordset on the table with query and worksheet names
Set rst = CurrentDb.OpenRecordset(strSQL)
If rst.EOF Then
'handle error here
Else
' Select the appropriate worksheet
Set objXLWs = objXLApp.ActiveWorkbook.Worksheets(strWsName)
' Activate the selected worksheet
objXLWs.Activate
' Ask Excel to copy the data from the recordset starting with
strFirstCell
objXLWs.Range(strFirstCell).CopyFromRecordset rst

' Select the main worksheet
objXLApp.Worksheets(strWsName).Activate
' Activate the selected worksheet
Set objXLWs = objXLApp.ActiveWorkbook.Worksheets(strWsName)
'format cells
With objXLWs.Cells
.Range(.Cells(1, 1), .Cells(1, _
1).SpecialCells(xlCellTypeLastCell)).Borders.LineStyle = _
xlContinuous
.Range(.Cells(1, 1), .Cells(1, _
1).SpecialCells(xlCellTypeLastCell)).Borders.ColorIndex = _
xlAutomatic
.Font.Size = 9
.Font.Name = "Arial Narrow"
.WrapText = True

End With

End If


'**error handling, in the Sub exit - make sure you set the object
'references to nothing as shown below.

SubExit:
' Save the workbook
objXLApp.ActiveWorkbook.Save
Set objXLWs = Nothing
Set objXLApp = Nothing
' Destroy the recordset and database objects
rst.Close
If Not rst Is Nothing Then
Set rst = Nothing
End If

Exit Sub

SubErr:
MsgBox Err.Description & " " & Err.Number
Resume SubExit
End Sub


Jeanette Cunningham