[VB6]Error 50290: Error writing to Worksheet while using an ActiveX Control

因為客戶將Office 2000升級到Office 2010,結果程式在Assign值給Cell時,居然發生「Error 50290: Error writing to Worksheet while using an ActiveX Control」的錯誤!

最近有支VB6寫的程式,有透過Excel物件去建立Excel檔案。

程式大約如下的Code,

Set ExcelApp = CreateObject("Excel.Application")
With ExcelApp
	.Visible = True
	.DisplayAlerts = False

	'開啟一個新的excel
	.Workbooks.Add
	strSql = "SELECT * FROM MYTABLE"
	If gobjDB.OpenSQL(strSql) Then
		Set objRS = gobjDB.OpenDisConRecordSet(strSql)
        If objRS.RecordCount > 0 Then
			ActiveSheet.Name = "Sheet1"
            .ActiveWorkbook.Worksheets("Sheet1").Activate
            .ActiveWorkbook.Worksheets("Sheet1").Cells(1, 1) = "單位"
            .ActiveWorkbook.Worksheets("Sheet1").Cells(1, 2) = "流程單位"
            '開始塞資料
            objRS.MoveFirst
            rsData.MoveFirst
			intI = 3
            While Not objRS.EOF
                For intJ = 1 To 8 + rsData.RecordCount * 4
                        .ActiveWorkbook.Worksheets("Sheet1").Cells(intI, intJ).NumberFormatLocal = "@"
                        .ActiveWorkbook.Worksheets("Sheet1").Cells(intI, intJ) = IIf(Trim(objRS(intJ - 1)) = 0, "", Trim(objRS(intJ - 1)))
                    End If
                Next intJ
                intI = intI + 1
                objRS.MoveNext
            Wend
		End If
	End If
	.Visible = True
End With

 

因為客戶將Office 2000升級到Office 2010,結果程式在Assign值給Cell時,居然發生「Error 50290: Error writing to Worksheet while using an ActiveX Control」的錯誤!

查網路是說 Excel 的 Version >= 10 之後,要判斷Ready屬性判斷,所以就在Assign Cell值前,先加入Ready屬性判斷,如下處理OFFICE 2010無法使用問題註解的部份,

Set ExcelApp = CreateObject("Excel.Application")
With ExcelApp
	.Visible = True
	.DisplayAlerts = False

	'開啟一個新的excel
	.Workbooks.Add
	strSql = "SELECT * FROM MYTABLE"
	If gobjDB.OpenSQL(strSql) Then
		Set objRS = gobjDB.OpenDisConRecordSet(strSql)
        If objRS.RecordCount > 0 Then
			ActiveSheet.Name = "Sheet1"
            .ActiveWorkbook.Worksheets("Sheet1").Activate
            .ActiveWorkbook.Worksheets("Sheet1").Cells(1, 1) = "單位"
            .ActiveWorkbook.Worksheets("Sheet1").Cells(1, 2) = "流程單位"
            '開始塞資料
            objRS.MoveFirst
            rsData.MoveFirst
			intI = 3
            While Not objRS.EOF
				'處理OFFICE 2010無法使用問題
                If Val(ExcelApp.Version) >= 10 Then
                    'Check the application status to see if it is available fo processing.
                    While ExcelApp.Ready = False
                        DoEvents
                    Wend
                End If
                For intJ = 1 To 8 + rsData.RecordCount * 4
					'處理OFFICE 2010無法使用問題
                    If Val(ExcelApp.Version) >= 10 Then
                        If ExcelApp.Ready = True Then
                            .ActiveWorkbook.Worksheets("Sheet1").Cells(intI, intJ).NumberFormatLocal = "@"
                            .ActiveWorkbook.Worksheets("Sheet1").Cells(intI, intJ) = IIf(Trim(objRS(intJ - 1)) = 0, "", Trim(objRS(intJ - 1)))
                        End If
                    Else
                        .ActiveWorkbook.Worksheets("Sheet1").Cells(intI, intJ).NumberFormatLocal = "@"
                        .ActiveWorkbook.Worksheets("Sheet1").Cells(intI, intJ) = IIf(Trim(objRS(intJ - 1)) = 0, "", Trim(objRS(intJ - 1)))
                    End If
                Next intJ
                intI = intI + 1
                objRS.MoveNext
            Wend
		End If
	End If
	.Visible = True
End With

 

'處理OFFICE 2010無法使用問題
If Val(ExcelApp.Version) >= 10 Then
	'Check the application status to see if it is available fo processing.
	While ExcelApp.Ready = False
		DoEvents
	Wend
End If

參考資料

Error 50290: Error writing to Worksheet while using an ActiveX Control

Hi, 

亂馬客Blog已移到了 「亂馬客​ : Re:從零開始的軟體開發生活

請大家繼續支持 ^_^