Automating excel

06-21-2005, 02:20 AM
Im using OLE Automation to create an Excel instance and fill it with data in Visual Basic 6.0. This works just fine for most users. But one user has problems with filling the data. The instance is created and it seems to be working but the sheet comes up empty.

I was wondering if there are any settings in excel that prohibits the actual insertion? Cause the user has same version on both OS and Office as the users that successfully fills the sheet.

Or does anybody have a clue whats causing this.

Public Sub PrintGridToExcel(ByVal Grid As gridex, Optional ByVal data As Variant)

Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Excel.Worksheet
Dim rst As New ADODB.Recordset

Dim recArray As Variant
Dim headers As Variant
Dim fldCount As Integer
Dim recCount As Long
Dim iCol As Integer
Dim iRow As Integer

On Error GoTo ErrorHandler

' Create an instance of Excel and add a workbook
Set xlApp = CreateObject("Excel.Application")
If IsObject(xlApp) Then

Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets(1)

' Display Excel and give user control of Excel's lifetime
xlApp.Visible = True 'False sänker prestandan vid CopyFromRecordset märkligt nog.
xlApp.UserControl = True

If Not IsMissing(data) Then
Dim col As Long
Dim colarr As Variant
ReDim colarr(1)
For col = 1 To Grid.Columns.Count
If Not (Grid.Columns.Item(col).Visible) Then
colarr(UBound(colarr) - 1) = col - 1
ReDim Preserve colarr(UBound(colarr) + 1)
End If

For col = 0 To UBound(colarr) - 2
data = DeleteColumnMatrix(data, colarr(col))
For iCol = 0 To UBound(colarr) - 1
colarr(iCol) = colarr(iCol) - 1
data = CreateDataArr(Grid)
End If

' Copy field names to the first row of the worksheet
'fldCount = rst.Fields.Count
headers = CreateHeadersArr(Grid)
For iCol = 1 To UBound(headers)
xlWs.Cells(1, iCol).Value = headers(iCol - 1)

' Determine number of records
fldCount = UBound(data, 1) + 1
recCount = UBound(data, 2) + 1 '+ 1 since 0-based array

' Check the array for contents that are not valid when
' copying the array to an Excel worksheet
For iCol = 0 To fldCount - 1
For iRow = 0 To recCount - 1
' Take care of Date fields
If Left(data(iCol, iRow), 1) = "=" Then
data(iCol, iRow) = "'" & data(iCol, iRow)
ElseIf IsArray(data(iCol, iRow)) Then
data(iCol, iRow) = "Array Field"
ElseIf IsNumeric(data(iCol, iRow)) Then
data(iCol, iRow) = replace(data(iCol, iRow), ",", ".")
End If
Next iRow 'next record
Next iCol 'next field

' Transpose and Copy the array to the worksheet,
' starting in cell A2
xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _

' Auto-fit the column widths and row heights
xlApp.Selection.CurrentRegion.VerticalAlignment = xlTop
' Release Excel references

Set xlWb = Nothing
Set xlApp = Nothing

MsgBox "ERROR: Creating Excel Object"
End If

Exit Sub

End Sub

06-21-2005, 03:46 PM
There's probably an error, but since your error handler just quits without saying anything, you're not getting any information about that... add something useful to your error handler, such as a MsgBox that reports the error number and description, and once you know that we can start looking at how to fix it.

EZ Archive Ads Plugin for vBulletin Copyright 2006 Computer Help Forum