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的时候就蹦出来。

13 个解决方案

#1

  你是否偷懒了??

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

    改

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

#2

引用 1 楼 vbyes 的回复:

你是否偷懒了??

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

    改

  xlApp.ActiveWorkbook.SaveAs FileName:="I:\2013\哈" & ".xlsx"
  xlA……

原来是这样，我不懂，呵呵，还有一点：就是Copy的那一下还是会显示Excel界面，这样要怎么解决这一步

#3

其实你的代码里做了些处理, 可能没有更好的方法了,因为既然有COPY操作,也就是需要动用那个库,估计闪现那个界面是免不了的,但我的电脑几乎没有.

#4

引用 3 楼 vbyes 的回复:

其实你的代码里做了些处理, 可能没有更好的方法了,因为既然有COPY操作,也就是需要动用那个库,估计闪现那个界面是免不了的,但我的电脑几乎没有.

另一种调用有什么不一样的吗？

Set xlBook = GetObject("I:\2013\Book1.xlsx")
Set xlSheet = xlBook.Sheets("BOM")

#5

不用Copy，用循环将其他不要的sheet表删除掉 ，然后另存为。

#6

'我用的是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

#7

 我 一般是用 GetObject , 差不多吧 ,最好添句红色语句
     xlApp.Quit
    Set xlApp = Nothing

#8

引用 6 楼 chenjl1031 的回复:

Visual Basic code?1234567891011121314151617181920212223242526272829'我用的是Excel 2003：Option ExplicitDim xlExcel As Excel.ApplicationDim xlBook As Excel.WorkbookDim xlSheet As Excel.Workshee……

这样有点不好的地方就是表中带有公式的情况，如果删除其他的表则出现很多错误

#9

引用 8 楼 mpy2003 的回复:

引用 6 楼 chenjl1031 的回复:
Visual Basic code?1234567891011121314151617181920212223242526272829'我用的是Excel 2003：Option ExplicitDim xlExcel As Excel.ApplicationDim xlBook As Excel.WorkbookDim xlSheet As Exc……

是有这个问题.
那你在xlsheet.copy后面加上一行就OK了：Application.DisplayAlerts = False '不提示保存

#10

引用 9 楼 chenjl1031 的回复:

引用 8 楼 mpy2003 的回复:引用 6 楼 chenjl1031 的回复:
Visual Basic code?1234567891011121314151617181920212223242526272829'我用的是Excel 2003：Option ExplicitDim xlExcel As Excel.ApplicationDim xlBook As ……

好像打开了其他Excel的时候有提示错误，在我之前的那段代码，今天在公司运行一下没有跳出Excel界面，昨天在家里一直会跳出，难道跟电脑配置有关？

#11

加上这行EXCEL不会显示界面: Application.Visible = False

#12

引用 7 楼 vbyes 的回复:

 我 一般是用 GetObject , 差不多吧 ,最好添句红色语句
     xlApp.Quit
    Set xlApp = Nothing

请问，在打开了其他的Excel的时候会提示对象没有定义，如果没有打开其他的Excel则不会出错
这个要怎么样解决？

#13

最终解决方案：

Private Sub Command2_Click()
Dim xlApp As Excel.Application
Dim MBook As Excel.Workbook
Dim MSheet As Excel.Worksheet
Dim BBook As Excel.Workbook
Dim BSheet As Excel.Worksheet
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    xlApp.ScreenUpdating = False
    xlApp.DisplayAlerts = False
    Set MBook = xlApp.Workbooks.Open(路径1 & "表一.xlsx")       '作为模板的表
    Set BBook = xlApp.Workbooks.Open(路径2 & "表二.xlsx")       '工作数据表
    Set BSheet = BBook.Worksheets("Sheet1")
    分类 = BSheet.Cells(1, 1)
    Set MSheet = MBook.Worksheets(分类)
    MSheet.Unprotect ("qwe")        '取消模板的密码
    BSheet.Range(BSheet.Cells(1, 9) & ":" & BSheet.Cells(1, 10)).Copy       '从工作表复制数据到模板
    MSheet.Range("A7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    MSheet.Range("A7").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    FilePath = App.Path & "\外协BOM" & ".xlsx"
    MSheet.Copy
    xlApp.ActiveWorkbook.SaveAs FileName:=FilePath  '将模板的一个工作表另存为指定工作表
    xlApp.ActiveWorkbook.PrintOut ActivePrinter:="Adobe PDF"        '用PDF虚拟打印机打印
    xlApp.ActiveWorkbook.Close True
    BBook.Close False
    MBook.Close False
    xlApp.Visible = True
    xlApp.ScreenUpdating = True
    xlApp.DisplayAlerts = True
    xlApp.Quit
End Sub