J
jim moose
Hiya All
Ive got an vb application that opens MS Excel 200, to produce some
tables retreived from a database record set. All works fine the first time
that Excel is opened, and whilst it remains open susbsquent interaction with
Excel is fine as new tables are produced on sheet one.
If the Excel application is closed by the user then reopened however, Excel
re opens but no Worksheet is visible. Im aware that because my
Excel.Application object is global within my vb application that Excel is
visible form the task manager, i check on entering my Excel open method
whether an Excel object is avaiable through the Err code and also using is
nothing. Code below is available to guff at,
My one idea is from
http://support.microsoft.com/defaul...port/kb/articles/q178/5/10.asp&NoWebContent=1
which is concerned with referencing,
rather new to excel and vb, however if anyone has had similar experinces or
idea will be apprec
<<<<<CODE>>>>>>
jim
Public Sub openExcel(QueryName As String)
Const rowstart = 2
Dim myWorkbook As Excel.Workbook
Dim mySheet As Worksheet
Dim myRS As DAO.Recordset
Dim I As Integer
'ignore errors
On Error Resume Next
Err.Clear
If myExcel Is Nothing Then
'look for a running copy of Wor
Set myExcel = GetObject(, "Excel.Application")
'If Word is not running then
If Err.Number = 429 Then
Set myExcel = CreateObject("Excel.Application") 'run it
' Clear error
Err.Clear
End If
End If
If myExcel.ActiveWorkbook Is Nothing Then
' Add a work book
Set myWorkbook = myExcel.Workbooks.Add
Else
Set myWorkbook = myExcel.ActiveWorkbook
End If
' Get a reference to the first sheet
Set mySheet = myWorkbook.ActiveSheet
If mySheet Is Nothing Then
Set mySheet = myWorkbook.Sheets.Add(1)
End If
myWorkbook.RefreshAll
mySheet.Visible = xlSheetVisible
' Open record set
Set myRS = dbsApex.OpenRecordset(QueryName)
'This loop will collect the field names and place them in the first
'row starting at "A1"
For I = rowstart To (myRS.Fields.Count + rowstart) - 1
mySheet.Cells(rowstart, I - rowstart + 1).Value = myRS.Fields(I -
rowstart).Name
Next I
'The next line simply formats the headers to bold font
With mySheet.Range(mySheet.Cells(rowstart, 1), mySheet.Cells(rowstart,
myRS.Fields.Count))
.Font.Bold = True
.Interior.Color = RGB(215, 215, 215)
End With
' Paste to worksheet
mySheet.Range("A" & CStr(rowstart + 2)).CopyFromRecordset myRS
'This next code set will just select the data region and
'auto-fit the columns
With myExcel
' .Sheets("Sheet1").Select
.ActiveSheet.Select
.Range("A" & CStr(rowstart + 2)).Select
.Selection.CurrentRegion.Select
.Selection.Columns.AutoFit
.Range("A" & CStr(rowstart + 2)).Select
.Visible = True
End With
' Ensure column width fits the headers
For I = rowstart To (myRS.Fields.Count + rowstart) - 1
If mySheet.Cells(rowstart, I - rowstart + 1).ColumnWidth <
Len(myRS.Fields(I - rowstart).Name) Then
mySheet.Cells(rowstart, I - rowstart + 1).ColumnWidth =
Len(myRS.Fields(I - rowstart).Name) + 5
End If
Next I
mySheet.PageSetup.Orientation = xlLandscape
' Clean up afterwords
Set myRS = Nothing
Set mySheet = Nothing
Set myWorkbook = Nothing
End Sub
Ive got an vb application that opens MS Excel 200, to produce some
tables retreived from a database record set. All works fine the first time
that Excel is opened, and whilst it remains open susbsquent interaction with
Excel is fine as new tables are produced on sheet one.
If the Excel application is closed by the user then reopened however, Excel
re opens but no Worksheet is visible. Im aware that because my
Excel.Application object is global within my vb application that Excel is
visible form the task manager, i check on entering my Excel open method
whether an Excel object is avaiable through the Err code and also using is
nothing. Code below is available to guff at,
My one idea is from
http://support.microsoft.com/defaul...port/kb/articles/q178/5/10.asp&NoWebContent=1
which is concerned with referencing,
rather new to excel and vb, however if anyone has had similar experinces or
idea will be apprec
<<<<<CODE>>>>>>
jim
Public Sub openExcel(QueryName As String)
Const rowstart = 2
Dim myWorkbook As Excel.Workbook
Dim mySheet As Worksheet
Dim myRS As DAO.Recordset
Dim I As Integer
'ignore errors
On Error Resume Next
Err.Clear
If myExcel Is Nothing Then
'look for a running copy of Wor
Set myExcel = GetObject(, "Excel.Application")
'If Word is not running then
If Err.Number = 429 Then
Set myExcel = CreateObject("Excel.Application") 'run it
' Clear error
Err.Clear
End If
End If
If myExcel.ActiveWorkbook Is Nothing Then
' Add a work book
Set myWorkbook = myExcel.Workbooks.Add
Else
Set myWorkbook = myExcel.ActiveWorkbook
End If
' Get a reference to the first sheet
Set mySheet = myWorkbook.ActiveSheet
If mySheet Is Nothing Then
Set mySheet = myWorkbook.Sheets.Add(1)
End If
myWorkbook.RefreshAll
mySheet.Visible = xlSheetVisible
' Open record set
Set myRS = dbsApex.OpenRecordset(QueryName)
'This loop will collect the field names and place them in the first
'row starting at "A1"
For I = rowstart To (myRS.Fields.Count + rowstart) - 1
mySheet.Cells(rowstart, I - rowstart + 1).Value = myRS.Fields(I -
rowstart).Name
Next I
'The next line simply formats the headers to bold font
With mySheet.Range(mySheet.Cells(rowstart, 1), mySheet.Cells(rowstart,
myRS.Fields.Count))
.Font.Bold = True
.Interior.Color = RGB(215, 215, 215)
End With
' Paste to worksheet
mySheet.Range("A" & CStr(rowstart + 2)).CopyFromRecordset myRS
'This next code set will just select the data region and
'auto-fit the columns
With myExcel
' .Sheets("Sheet1").Select
.ActiveSheet.Select
.Range("A" & CStr(rowstart + 2)).Select
.Selection.CurrentRegion.Select
.Selection.Columns.AutoFit
.Range("A" & CStr(rowstart + 2)).Select
.Visible = True
End With
' Ensure column width fits the headers
For I = rowstart To (myRS.Fields.Count + rowstart) - 1
If mySheet.Cells(rowstart, I - rowstart + 1).ColumnWidth <
Len(myRS.Fields(I - rowstart).Name) Then
mySheet.Cells(rowstart, I - rowstart + 1).ColumnWidth =
Len(myRS.Fields(I - rowstart).Name) + 5
End If
Next I
mySheet.PageSetup.Orientation = xlLandscape
' Clean up afterwords
Set myRS = Nothing
Set mySheet = Nothing
Set myWorkbook = Nothing
End Sub