如可把mshflexgrid 的内容直接导入到execl表格中去?急急!!!
我要把mshflexgird中text的内容直接导入execl表格中去,要求不能以文本文件作为过度,如果可以的话shell一类的语句能做到的话,请告诉我方法,如果有别的方法实现,我也想听听方法。在线等待。 问题点数:20、回复次数:8Top
1 楼SuperZhou(2004↑)回复于 2002-05-30 10:16:54 得分 10
Public Sub ExportToExcel(ctlMshg As MSHFlexGrid, rstRecord As ADODB.Recordset, _
strReportCaption As String, strReportHead As String, _
strReportTail As String, strFileName As String, blnCount As Boolean)
Dim xlApp As Excel.Application '定义Excel应用对象
Dim xlBook As Excel.Workbook '定义Excel工作簿对象
Dim xlSheet As Excel.Worksheet '定义Excel工作表对象
Dim i As Long, j As Long, k As Long, l As Long
Dim strTemp As String
On Error GoTo ErrHandler
If FileExists(strFileName) Then
Kill strFileName
End If
Set xlApp = New Excel.Application
xlApp.SheetsInNewWorkbook = 1
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.ActiveSheet
k = rstRecord.AbsolutePage '保存记录集的页位置
rstRecord.MoveFirst
l = ctlMshg.Cols
strTemp = "A1:" & Chr(65 + l - 1) & "1"
xlSheet.Range(strTemp).MergeCells = True
xlSheet.Range(strTemp).Value = strReportCaption
strTemp = "A2:" & Chr(65 + l - 1) & "2"
xlSheet.Range(strTemp).MergeCells = True
xlSheet.Range(strTemp).Value = strReportHead
For i = 0 To l - 1
xlSheet.Cells(3, i + 1).Value = ctlMshg.TextMatrix(0, i)
Next i
i = 4
With rstRecord
Do Until .EOF
For j = 0 To l - 1
strTemp = rstRecord.Fields(j).Value
xlSheet.Cells(i, j + 1).Value = IIf(blnCount, strTemp, "'" & strTemp)
Next
DoEvents
i = i + 1
.MoveNext
Loop
End With
If blnCount Then
xlSheet.Cells(i, 1).Value = "合计"
For j = 1 To l - 1
strTemp = "=SUM(" & Chr(65 + j) & 4 & ":" & Chr(65 + j) & (i - 1) & ")"
xlSheet.Cells(i, j + 1).Value = strTemp
Next j
i = i + 1
End If
strTemp = "A" & i & ":" & Chr(65 + l - 1) & i
xlSheet.Range(strTemp).MergeCells = True
xlSheet.Range(strTemp).Value = strReportTail
xlSheet.SaveAs strFileName '保存导出的Excel文件
xlApp.DisplayAlerts = False
xlBook.Close
xlApp.Quit '退出EXCEL
xlApp.DisplayAlerts = True
Set xlApp = Nothing
If k > 0 Then
rstRecord.AbsolutePage = k '恢复记录集的页位置
End If
Exit Sub
ErrHandler:
If k > 0 Then
rstRecord.AbsolutePage = k
End If
MsgBox "错误:" & Err.Description & "!", vbExclamation, "系统提示"
End SubTop
2 楼_1_(该用户已封杀)回复于 2002-05-30 10:17:55 得分 0
最多一行一行的写了....
调用EXCEL对象Top
3 楼mornwoo(爱永恒伤离别)回复于 2002-05-30 10:26:11 得分 10
'将数据输出为excel文件
Private Sub s_OutToExcel()
Screen.MousePointer = vbHourglass
Dim oXl As Excel.Application
Dim oWb As Workbook
Dim oWs As Excel.Worksheet
Dim iA, iB, iC, iD
Dim bExcelRunning 'Excel是否已运行
Dim flg As MSFlexGrid
Dim sStr
On Error GoTo Morn
bExcelRunning = True '同首先用的GetObject一致:假设Excel已运行
Set oXl = GetObject("", "Excel.Application")
Set oWb = oXl.Workbooks.Add
Set oWs = oWb.Worksheets(1)
Set flg = mOform.flg
With oWs
For iB = 1 To flg.Cols
.Cells(1, iB).Value = flg.TextMatrix(0, iB - 1)
Next
For iC = 1 To flg.Rows - 1
For iB = 1 To flg.Cols
sStr = Trim(flg.TextMatrix(iC, iB - 1))
If IsNumeric(sStr) Then
.Cells(iC + 1, iB).Value = sStr
Else
'截取尾部的数字
If IsNumeric(Right(sStr, 1)) Then sStr = Left(sStr, Len(sStr) - 1)
If IsNumeric(Right(sStr, 1)) Then sStr = Left(sStr, Len(sStr) - 1)
.Cells(iC + 1, iB).Value = sStr
End If
Next
Next
End With
oWs.Parent.Names.Add "CostRange", "=" & "A1:B39"
sStr = App.Path & "\" & mOform.Caption & ".xls"
oWs.SaveAs sStr
Screen.MousePointer = vbDefault
If MsgBox("已将数据输出到Excel文件中! 现在打开该文件?", vbQuestion + vbYesNo, "已完成") = vbNo Then
oXl.Quit
Else
oXl.Visible = True
End If
Set oXl = Nothing
Set oWs = Nothing
Set oWb = Nothing
Exit Sub
Morn:
Select Case Err.number
Case 429
Set oXl = GetObject("", "Excel.Application")
bExcelRunning = False
Resume Next
Case 1004
Screen.MousePointer = 0
iA = MsgBox("发生了错误" & Err.number & ": " & Err.Description, vbExclamation + vbAbortRetryIgnore + vbDefaultButton3, "错误")
If iA = vbAbort Then Exit Sub
If iA = vbRetry Then
Resume
Else
Resume Next
End If
Case Else
MornSubs.sub_ErrCenter False
End Select
End Sub
Top
4 楼normandj(norman)回复于 2002-05-30 10:33:38 得分 0
Dim xlApp As Excel.Application
说我用户定义类型未定义,
请问如何定义?Top
5 楼footballboy(郑创斌)回复于 2002-05-30 10:37:12 得分 0
工程-引用-Microsoft Excel X.0 Object LibaryTop
6 楼SuperZhou(2004↑)回复于 2002-05-30 10:39:20 得分 0
要到工程->引用中选择Microsoft Excel 9.0(或8.0) Object LibraryTop
7 楼hxhan(王寒)回复于 2002-05-30 10:44:16 得分 0
你可以这样定义:
如:Dim xlApp as object
这样再继续执行就可以了。因为我刚刚用过,如你还有不明白的再问我,Top
8 楼mornwoo(爱永恒伤离别)回复于 2002-05-30 11:01:14 得分 0
补充:你的操作系统必须安装了excell,
而将来程序运行的环境下也必须安装有excell,
Top




