VB而非VBA将Excel工作簿的一个表独自保存为一个工作簿

2013-04-26

VB而非VBA将Excel工作簿的一个表单独保存为一个工作簿工程中引用了Excel模块Dim xlApp As ObjectExcel 对

VB而非VBA将Excel工作簿的一个表单独保存为一个工作簿
工程中引用了Excel模块

Dim xlApp As Object          'Excel 对象
Dim xlBook As Object         '临时工作簿
Dim xlSheet As Object        '临时工作表

Private Sub Command1_Click()
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    xlApp.ScreenUpdating = False
    xlApp.DisplayAlerts = False
    Set xlBook = xlApp.Workbooks.Open("I:\2013\Book1.xlsx")
    Set xlSheet = xlBook.Worksheets("BOM")
    xlSheet.Copy
    ActiveWorkbook.SaveAs FileName:="I:\2013\哈" & ".xlsx"
    ActiveWorkbook.Close True
    xlBook.Close False
    xlApp.ScreenUpdating = True
    xlApp.DisplayAlerts = True
    Set xlApp = Nothing
End Sub

我刚调试的时候发现执行第一次的时候没有问题，但是执行第二的时候会出错
还有就是在xlsheet.copy的时候怎么样不让xlapp显示并保存？现在每次Copy的时候就蹦出来。 Excel 另存工作簿
[解决办法]
  你是否偷懒了??

  ActiveWorkbook.SaveAs FileName:="I:\2013\哈" & ".xlsx"
  ActiveWorkbook.Close True

    改

  xlApp.ActiveWorkbook.SaveAs FileName:="I:\2013\哈" & ".xlsx"
  xlApp.ActiveWorkbook.Close True
[解决办法]

'我用的是Excel 2003：
Option Explicit
Dim xlExcel As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Private Sub Command1_Click()
        On Error GoTo Errhandler
        CommonDialog1.Filter = "Excel(*.xls)
[解决办法]
*.xls
[解决办法]
AllFile(*.*)
[解决办法]
*.*"
        CommonDialog1.FilterIndex = 1
        CommonDialog1.ShowOpen
        Set xlExcel = New Excel.Application
        xlExcel.Workbooks.Open CommonDialog1.FileName
        Set xlBook = xlExcel.Workbooks(CommonDialog1.FileTitle)
        Application.Visible = False
        Application.DisplayAlerts = False '不提示保存
        For Each xlSheet In xlBook.Worksheets
           Set xlSheet = xlBook.Worksheets(xlSheet.Name)
           If xlSheet.Name <> "Sheet1" Then xlSheet.Delete '只保留Sheet1表

        Next
        xlBook.Save

Errhandler:
        xlBook.Close
        xlExcel.Quit
        Set xlSheet = Nothing
        Set xlBook = Nothing
        Set xlExcel = Nothing
End Sub

热点排行