标签:
转载 |
原文地址:VB---另存为EXCEL文件代码作者: 碧海潮声
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
On Error GoTo Err_Proc
dff.CommonDialog1.Filter = "Microsoft Excel 工作簿|*.xls|文本文件(*. txt)|*.txt|所有文件(*.*)|*.*"
dff.CommonDialog1.FileName = ".xls"
dff.CommonDialog1.InitDir = "D:"
dff.CommonDialog1.ShowSaveAs
With dff.MSFlexGrid1
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()
On Error GoTo Err_Proc
Dim iRows
Dim iCols
Dim objExcel
Dim objWorkBook
Dim objSheet
Dim objRange
Dim sFile As String
dff.CommonDialog1.Filter = "Microsoft Excel 工作簿|*.xls|文本文件(*. txt)|*.txt|所有文件(*.*)|*.*"
dff.CommonDialog1.FileName = ".xls"
dff.CommonDialog1.InitDir = "D:"
dff.CommonDialog1.ShowOpen
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
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