VB中怎么把EXCEL表另存
DimXlAppAsNewExcel.ApplicationDimxlBookAsNewExcel.WorkbookDimxlSheetAsNewExcel.Worksh...
Dim XlApp As New Excel.Application
Dim xlBook As New Excel.Workbook
Dim xlSheet As New Excel.Worksheet
Set xlBook = XlApp.Workbooks.Open("C:\SSS.xls")
XlApp.Visible = False
Set xlSheet = xlBook.Sheets("sheet1")
xlSheet.Select
xlSheet.Range("c4") = Text1.Text
xlSheet.Range("c7") = Text2.Text
xlSheet.Range("c5") = Text3.Text
xlSheet.Range("i10") = Text5.Text
xlBook.Save 这里现在是保存,但是我想要点击command的时候,会自动弹出一个提示另存的对话 框,并且可以选择具体另存的路径和保存名称,就和excel表格另存是一样,有没有具体代码,谢谢 Set Sheet = Nothing
Set xlBook = Nothing
XlApp.Quit
Set XlApp = Nothing 展开
Dim xlBook As New Excel.Workbook
Dim xlSheet As New Excel.Worksheet
Set xlBook = XlApp.Workbooks.Open("C:\SSS.xls")
XlApp.Visible = False
Set xlSheet = xlBook.Sheets("sheet1")
xlSheet.Select
xlSheet.Range("c4") = Text1.Text
xlSheet.Range("c7") = Text2.Text
xlSheet.Range("c5") = Text3.Text
xlSheet.Range("i10") = Text5.Text
xlBook.Save 这里现在是保存,但是我想要点击command的时候,会自动弹出一个提示另存的对话 框,并且可以选择具体另存的路径和保存名称,就和excel表格另存是一样,有没有具体代码,谢谢 Set Sheet = Nothing
Set xlBook = Nothing
XlApp.Quit
Set XlApp = Nothing 展开
展开全部
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
'/*数据输出到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
展开全部
xlBook.SaveAs Filename:= "C:\Users\Administrator\Desktop\dfaddsasdaaaa.xls"
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
亲,试一下这个吧:
XlApp.Dialogs(5).Show
XlApp.Dialogs(5).Show
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
试试
xlBook.SaveAs
xlBook.SaveAs
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询