Question

vb编程如何保存100excel文件

Answer 1

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