加载中…
个人资料
  • 博客等级:
  • 博客积分:
  • 博客访问:
  • 关注人气:
  • 获赠金笔:0支
  • 赠出金笔:0支
  • 荣誉徽章:
正文 字体大小:

[转载]VB---另存为EXCEL文件代码

(2012-09-07 00:57:05)
标签:

转载

Public Sub FileSave()          '保存文档
                               '/*数据输出到Excel
On Error GoTo Err_Proc
    Dim xlApp As Object 'Excel.Application
    Dim xlBook As Object  'Excel.Workbook
    Dim xlSheet As Object  'Excel.Worksheet
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Sheets(1)
dff.CommonDialog1.Filter = "Microsoft Excel 工作簿|*.xls|文本文件(*. txt)|*.txt|所有文件(*.*)|*.*"
dff.CommonDialog1.FileName = ".xls"
dff.CommonDialog1.InitDir = "D:"
dff.CommonDialog1.ShowSaveAs
With dff.MSFlexGrid1
        '/*设置列宽
        For j = 0 To .Cols - 1
            xlSheet.Columns(j + 1).ColumnWidth = .ColWidth(j) / 100
        Next j
        For I = 0 To .Rows - 1
            For j = 0 To .Cols - 1
              xlSheet.Cells(I + 1, j + 1).Value = " " & .TextMatrix(I, j)
            Next j
        Next I
End With
xlSheet.SaveAs (dff.CommonDialog1.FileName)
xlBook.Close
Set xlBook = Nothing
Set xlSheet = Nothing
Set xlApp = Nothing
flag8 = 1
Call PutWindowNoOnTop(dff)
MsgBox "计算结果已成功保存!", 0 + vbInformation, "提示"
Exit Sub
Err_Proc:
flag8 = 0
Set xlBook = Nothing
Set xlSheet = Nothing
Set xlApp = Nothing
Call PutWindowNoOnTop(dff)
MsgBox "您已取消保存!", vbExclamation, "提示"
Call PutWindowOnTop(dff)
End Sub

Public Sub FileOpen()          '打开文档
                    '/Excel数据输出到Msflexgrid表格
On Error GoTo Err_Proc
Dim iRows     As Integer
Dim iCols     As Integer
Dim objExcel     As excel.Application
Dim objWorkBook     As excel.Workbook
Dim objSheet     As excel.Worksheet
Dim objRange     As excel.Range
Dim sFile As String
dff.CommonDialog1.Filter = "Microsoft Excel 工作簿|*.xls|文本文件(*. txt)|*.txt|所有文件(*.*)|*.*"
dff.CommonDialog1.FileName = ".xls"
dff.CommonDialog1.InitDir = "D:"
dff.CommonDialog1.ShowOpen
        Set objExcel = New excel.Application
        Set objWorkBook = objExcel.Workbooks.Open(dff.CommonDialog1.FileName)
        Set objSheet = objWorkBook.ActiveSheet
        Set objRange = objSheet.UsedRange
        iRows = objRange.Rows.Count
        iCols = objRange.Columns.Count
dff.MSFlexGrid1.Rows = iRows
dff.MSFlexGrid1.Cols = iCols
For I = 0 To iRows - 1
dff.MSFlexGrid1.RowHeight(I) = 500
Next I
For I = 0 To iCols - 1
dff.MSFlexGrid1.ColWidth(I) = dff.MSFlexGrid1.Width / 4 - 100
dff.MSFlexGrid1.ColAlignment(I) = flexAlignCenterCenter
Next I          '输出数据
        For I = 1 To iRows
            For j = 1 To iCols
             dff.MSFlexGrid1.TextMatrix(I - 1, j - 1) = objSheet.Cells(I, j)
            Next j
 Next I
objWorkBook.Close
Set objExcel = Nothing
Set objWorkBook = Nothing
Set objSheet = Nothing
flag8 = 1
Exit Sub
Err_Proc:
Set objExcel = Nothing
Set objWorkBook = Nothing
Set objSheet = Nothing
flag8 = 0
Call PutWindowOnTop(dff)
End Sub

0

  

新浪BLOG意见反馈留言板 欢迎批评指正

新浪简介 | About Sina | 广告服务 | 联系我们 | 招聘信息 | 网站律师 | SINA English | 产品答疑

新浪公司 版权所有