把VB中的MSFlexGrid控件导出的数据不能自动保存,请各路大神帮忙解决

PublicSubOutDataToExcel(FlexAsMSFlexGrid)'导出至ExcelDimsAsStringDimiAsIntegerDimjAsInte... Public Sub OutDataToExcel(Flex As MSFlexGrid) '导出至Excel
Dim s As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim strpath As String
Dim Name As String
Name = TextName.Text
strpath = TextPc.Text
On Error GoTo Ert
Me.MousePointer = 11 '鼠标图标显示图形
On Error Resume Next
'前期绑定
Dim exlapp As Excel.Application
Set exlapp = New Excel.Application
Dim wsBook As Workbook '定义工作溥
Dim wsSheet As Worksheet '定义工作表
With exlapp
.SheetsInNewWorkbook = 1
.DefaultFilePath = App.Path & strpath
.DisplayFullScreen = False
.DisplayFormulaBar = True
.DisplayStatusBar = True
.Workbooks.Add
.Visible = False
Set wsBook = .ActiveWorkbook
Set wsSheet = .ActiveSheet
End With
With wsBook
.Activate
.Application.DisplayAlerts = True
.SaveAs (Name)
End With
DoEvents
With Flex
k = .Rows
For i = 0 To k - 1
For j = 0 To .Cols - 1
DoEvents
wsSheet.Cells(1 + i, j + 1) = "" & .TextMatrix(i, j)
Next j
Next i
End With
Me.MousePointer = 0
exlapp.Visible = True
exlapp.Quit
Ert:
If Not (exlapp Is Nothing) Then
End If
End Sub
调用次函数,准会弹出是否保存的对话框,现在想实现导出后自动存盘,不用再显示EXCEL表
展开
 我来答
爱栀竹的人
2013-06-27 · TA获得超过1352个赞
知道大有可为答主
回答量:1743
采纳率:0%
帮助的人:1000万
展开全部
给你个能用的直接用吧
Sub sub_FlgDataToExcel(iStartCol As Integer, Optional sTitle = "", Optional sFileName = "")
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 = Screen.ActiveForm.flg '在这里把你的msflexgrid控件赋值给flg
With oWs

oXl.DisplayAlerts = False '禁止提示

oWs.Cells.HorizontalAlignment = 3 '//居中问题
oWs.Cells.VerticalAlignment = 3

For iB = 1 To flg.cols - iStartCol
.Cells(1, iB) = sTitle
.Cells(2, iB).Value = flg.TextMatrix(0, iB - 1 + iStartCol)
.Columns(iB).ColumnWidth = flg.ColWidth(iB - 1 + iStartCol) / 100
Next
.Range(.Cells(1, 1), .Cells(1, flg.cols - iStartCol)).MergeCells = True
For iC = 2 To flg.Rows - 1
For iB = 1 To flg.cols - iStartCol
sStr = Trim(flg.TextMatrix(iC, iB + iStartCol - 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"
If sFileName = "" Then
sFileName = “test”
End If
sStr = App.Path & "\" & sFileName & ".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
Case Else

End Select

End Sub
追问
本人算是个菜鸟吧,没怎么看明白,给发个调用函数的例子,十分感谢
追答
函数过程还不是一样用

Sub sub_FlgDataToExcel(iStartCol As Integer, Optional sTitle = "", Optional sFileName = "")

第一个参数是起始列,也就是说你想从表格的第几列开始输出。
第二个参数是指 excel 的标题,可以为空
第三个参数是指你输出的excel文件名。
过程里需要你改的一个地方
Set flg = Screen.ActiveForm.flg '在这里把你的msflexgrid控件赋值给flg

上面一句要把你窗口上的msflexgrid控件赋给flg

调用方式,例如:
sub_FlgDataToExcel 0,,“C:\test.xls”
sub_FlgDataToExcel 1,"三班英语成绩",“C:\temp\test.xls”
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式