VBA优秀 [英] VBA excel

问题描述

我有一个使用thisworkbook.path命令的子程序。在一个工作簿中，这很好，但在另一个工作簿中，它会出错。

I have a subroutine using thisworkbook.path command. In one workbook, this is fine, but in another workbook, it gives an error.

它给出消息：运行时错误：' - 2147418113（8000ffff）'：自动化错误灾难性故障

It gives the message: Runtime error: '-2147418113 (8000ffff)': Automation error Catastrophic failure

给出错误的命令如下：

ActiveDirectory = ThisWorkbook.Path& " \"

ActiveDirectory = ThisWorkbook.Path & "\"

子例程代码如下：此代码在另一个工作簿中运行正常。有人帮忙。谢谢。

The subroutine code is as below: this code runs fine in another workbook. Someone kindly help. Thank you.

Private Sub Extract_Worksheets_Click（）

Dim c，x As Integer，WSname As String

Application.ScreenUpdating = False

Private Sub Extract_Worksheets_Click()
Dim c, x As Integer, WSname As String
Application.ScreenUpdating = False

ip = InputBox（""，" Enter Password"，" **********"，200,8000）

如果Len（ip）= 0则退出Sub $

ip = InputBox("", "Enter Password", "**********", 200, 8000)
If Len(ip) = 0 Then Exit Sub

ActiveDirectory = ThisWorkbook.Path& " \"

ActiveDirectory = ThisWorkbook.Path & "\"

'激活主工作簿（要复制工作表）

    ChDir ActiveDirectory

    ThisWorkbook.Activate

'Activates Main Workbook (where worksheets are to be copied from)
    ChDir ActiveDirectory
    ThisWorkbook.Activate

originfilenamepath = ThisWorkbook.FullName

originfilenamepath = ThisWorkbook.FullName

WSname = QUOT;"

将myrange =选择<无线电通信/>
For myrange in myrange

   表格（Cell.Value）.Visible = True

如果WSname =""然后WSname =左（Cell.Value，20）否则_

&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP; WSname = WSname& "，" &安培;左（Cell.Value，20）
$
下一个单元格

WSname = ""
Set myrange = Selection
For Each Cell In myrange
    Sheets(Cell.Value).Visible = True
If WSname = "" Then WSname = Left(Cell.Value, 20) Else _
                    WSname = WSname & "," & Left(Cell.Value, 20)
Next Cell

'添加工作簿2

    Workbooks.Add

'从工作簿1到2复制工作表

每个单元格在myrange中$
    ThisWorkbook.Sheets（Cell.Value）.Copy before：= Workbooks（Workbooks.Count）.Sheets（Sheets.Count）

Next Cell

'Add Workbook 2
    Workbooks.Add
'Copies Worksheets from Workbook 1 to 2
For Each Cell In myrange
    ThisWorkbook.Sheets(Cell.Value).Copy before:=Workbooks(Workbooks.Count).Sheets(Sheets.Count)
Next Cell

'  &NBSP;&NBSP; ThisWorkbook.Sheets（QUOT;名称"）复制之前：=工作簿（Workbooks.Count）.Sheets（Sheets.Count）

'    ThisWorkbook.Sheets("Names").Copy before:=Workbooks(Workbooks.Count).Sheets(Sheets.Count)

"与最新的名称保存新的工作簿2工作表

   工作簿（Workbooks.Count）。激活

    ActiveWorkbook.BreakLink名称：= originfilenamepath，类型：= xlExcelLinks

    ActiveWorkbook.SaveAs文件名：= ActiveDirectory& WSname& " .xlsm"，_

        FileFormat：= xlOpenXMLWorkbookMacroEnabled，CreateBackup：= False

    ActiveWorkbook.Close

'Saving the new Workbook 2 with the name of the latest worksheet
    Workbooks(Workbooks.Count).Activate
    ActiveWorkbook.BreakLink Name:=originfilenamepath, Type:=xlExcelLinks
    ActiveWorkbook.SaveAs Filename:=ActiveDirectory & WSname & ".xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWorkbook.Close

推荐答案

代码行没问题，但实际上是否保存了工作簿，以便它有一个路径，或者在保存工作簿之前运行代码？

The line of code is OK but have you actually saved the workbook so that it has a path or are you running the code before saving the workbook?

如果你的代码你会做得更好你将Option Explicit包含在每个模块的第一行（在任何潜艇之前）。然后，您将需要对每个变量进行维度，但优点是在尝试运行任何代码之前，您可以选择菜单
item Debug - >编译，如果任何变量尚未尺寸它会告诉你，很多时候你会发现它很简单，因为你拼错代码中的一个变量&NBSP;使用编译&NBSP;也拿起其他错误，无数的尝试$ B $前b运行代码，但你会发现一些不能解决的问题，例如代码中用双引号括起来的工作表名称拼写错误。

You will do a lot better with your code if you include Option Explicit as the first line of every module (before any subs). You will then be required to dimension every variable but the advantage is that before attempting to run any code you can select menu item Debug -> Compile and if any variables have not been dimensioned it will advise you and quite often you will find it is simply because you misspelt a variable in the code. Using Compile also picks up on a myriad of other errors before attempting to run the code but you will find some that it does not pick up such as incorrect spelling of a worksheet name that is enclosed in double quotes in the code.

如果选择菜单项工具 - >选项并选中"需要变量声明"复选框。然后excel将自动添加"Option Explicit"到当前项目和所有未来项目的每个新模块。但是，
不会自动将其添加到当前项目的现有模块中。

If you select menu item Tools -> Options and check the box against "Require variable declaration" then excel will automatically add "Option Explicit" to every new module for the current project and all future projects. However, it will not auto add it to existing modules in your current project.

这篇关于VBA优秀的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！