Excel VBA工程已生成多个工作簿对象

c8ib6hqw  于 2023-06-30  发布在  其他
关注(0)|答案(8)|浏览(118)

我负责一个非常大的Excel 2010电子表格,链接到各种外部数据源,包括彭博社,65个工作表与VBA模块和引用其他VBA加载项。
我注意到VBA项目已经获得了多个Workbook Object。
这是标准的ThisWorkbook。然而,许多工作表也被Excel转换为Workbook对象,保留原始工作表作为前一个工作表的副本,减去代码。
这似乎不是任何人行为的结果。事实上,我认为不可能有多个Workbook对象!
例如,我有一个名为wksInputs的工作表,它现在已经转换成了Workbook对象,而原来的wksInputs现在被称为wksInputs 1。

我无法删除wksInputs Workbook对象。
有人能帮我解释一下这里发生了什么事,以及我如何才能解决这个问题?
非常感谢。

d8tt03nd

d8tt03nd1#

这是我的解决方案,它工作一致,你不需要手动复制工作表和代码到一个空白的工作簿。我已经在几个损坏的工作簿上测试了这个方法,这些工作簿在启动时给我“自动化错误-灾难性失败”错误。

注意:原始损坏文件保存为.xlsm

1.打开空白Excel工作簿
1.开发人员选项卡>宏安全性>禁用所有宏而不通知
1.关闭Excel
1.双击损坏的文件,例如MyFile.xlsm
1.文件>保存为...> MyFile.xlsb(而不是.xlsm),选择**.xlsb**格式才是关键
1.开发人员选项卡>宏安全性>启用所有宏(或您喜欢的任何安全级别)
1.关闭Excel
1.双击MyFile.xlsb

**文件已修复!**如果需要,您可以将MyFile.xlsb文件重新保存为.xlsm。根据我的经验,.xlsm文件很容易损坏,所以我打算养成总是使用.xlsb格式的习惯。

希望有人觉得这有帮助:)

rryofs0p

rryofs0p2#

我遇到了同样的问题,一个文件有多个工作簿对象,并在打开时生成“自动化错误-灾难性失败”错误。
我将 *.xlsm文件保存为 *. xlsb.当我重新打开 *.xlsb文件时,所有工作簿对象仍然在文件中。我合理地假设文件中的错误最终会导致问题,并辞职将所有内容复制到一个新文件中。
但是,当我关闭 *.xlsb文件并重新打开原始的 *.xlsm时,所有对象都消失了,并且文件没有生成“自动化错误-灾难性故障”错误。
奇怪的是,我承认,但问题仍然存在于 *.xlsb文件,但原来的 *.xlsm(这是一个我试图保存)是好的。
这可能是一次性的,但可能值得一试...

6mw9ycah

6mw9ycah3#

您可以通过执行"convert to .zip and unzip trick",然后将vbaProject.bin文件(宏代码文件)替换为来自具有不同工作表结构的其他项目的vbaProject.bin来引入此行为。我不知道这是不是发生在OP身上的事情,但这就是发生在我身上的事情。

bpzcxfmw

bpzcxfmw4#

当我将工作表作为参数传递给Sub时,代码中出现了这个问题,如下所示:
调用BuildCodeStrings(Sheet2,sAccount)
Sub BuildCodeStrings(wsSource As Worksheet,s As String)
为了解决这个问题,我创建了一个新的工作簿,将所有数据从原来的所有合法工作表复制到新工作簿中同名的工作表中。然后将原始工作簿中的所有代码复制到新工作簿中。
然后我将子例程调用改为
调用BuildCodeStrings(“IC Accounts”,sAccounts)
SubBuildCodeStrings(sSource As String,s As String)
并在我的子例程BuildCodeString中添加了一行代码:
设置wsSource = ThisWorkbook.Sheets(sSource)
我不知道是什么原因导致了这个问题,但这个解决方法对我很有效。

ijnw1ujt

ijnw1ujt5#

我在PowerPoint(2007)中遇到了同样的问题,其中“Slide 1”是空的,无法删除。@Scoox的回答给了我一个解决方案:
1.将所有VBA模块导出为文本(.bas)文件
1.将.pptm(或.xlsm)文件另存为.pptx(或.xlsx)
1.关闭PowerPoint(或Excel)
1.打开这个.pptx/.xlsx并将其保存为.pptm/.xlsm
1.导入原始VBA文本(.bas)文件
1.手动将所有按钮重新关联到原始宏功能
1.添加原始文件中的任何外部 * 引用 *
1.保存并测试是否一切正常
这对我很有效,我相信它也适用于Excel。

xxhby3vn

xxhby3vn6#

Office365也有同样的问题,发现了一个错误,我的公共常量和函数的参数有相同的名称。在函数中更改参数名称后,它不会再次发生。

cclgggtu

cclgggtu7#

我的错误是当我把一个工作表传递给一个函数,然后在一个for循环中使用这个变量名作为循环变量时引起的(因为我是一个糟糕而懒惰的程序员)。
作为完全重写工作簿的替代方法:
1.将所有工作表复制到新工作簿
1.将所有模块、窗体和类也复制到该文件中
1.将其保存为.xlsm
1.将两个文件名(新的和旧的)都更改为.zip
1.将新文件“xl/vbaProject.bin”复制到旧文件
1.将文件名改回.xlsm
这听起来好像你只是复制了所有内容,但这意味着你不必检查链接、命名范围、条件格式或数据验证来确保所有内容都正确复制。

slsn1g29

slsn1g298#

也许有人还需要这个。。我设法编写了解决方案…基本上,它创建一个副本,您的vba和excel副本到另一个在您的桌面。
:)
参考文献:

  1. Microsoft Visual Basic for Applications可扩展性5.3
  2. Microsoft脚本运行时
  3. Microsoft VBScript正则表达式5.5
  4. Microsoft Windows通用控件6.0
Sub CopiarHojasANuevoLibro()
     ' Desactivar actualizaciones de pantalla, alertas, eventos e interacción con el usuario
     ' Disable screen updates, alerts, events and user interaction
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
     Application.EnableEvents = False
     Application.Interactive = False

     ' Exportar los módulos de código al archivo
     ' Export code modules to file
     Call ExportModules

     ' Crear un nuevo libro de Excel
     ' Create a new Excel workbook
     Dim wbNuevo As Workbook
     Set wbNuevo = Workbooks.Add

     ' Renombrar la primera hoja del nuevo libro
     ' Rename the first sheet of the new workbook
     wbNuevo.Sheets(1).Name = "zzzzzzzzz"

     ' Copiar cada hoja del libro actual al nuevo libro
     ' Copy each sheet from the current workbook to the new workbook
     Dim ws As Worksheet
     For Each ws In ThisWorkbook.Worksheets
         ws.Copy After:=wbNuevo.Sheets(wbNuevo.Sheets.Count)
     Next ws

     ' Eliminar la primera hoja del nuevo libro
     ' Delete the first sheet of the new workbook
     wbNuevo.Sheets(1).Delete

     ' Activar el nuevo libro y realizar la importación de los módulos de código
     ' Activate the new workbook and import the code modules
     wbNuevo.Activate
     Call ImportModules

     ' Definir la ruta y el nombre del archivo de destino
     ' Define the path and name of the destination file
     Dim rutaArchivo As String
     rutaArchivo = "C:\Users\" & CStr(Environ$("Username")) & "\Desktop\CodeSaver " & Format(Date, "DD-MM-YYYY") & ".xlsm"

     ' Eliminar el archivo existente si existe
     ' Delete existing file if it exists
     On Error Resume Next
     Kill rutaArchivo
     On Error GoTo 0

     ' Guardar el libro activo en la ubicación especificada con el formato de archivo xlOpenXMLWorkbookMacroEnabled
     ' Save the active workbook to the specified location in the file format xlOpenXMLWorkbookMacroEnabled
     ActiveWorkbook.SaveAs Filename:=rutaArchivo, FileFormat:=xlOpenXMLWorkbookMacroEnabled

     ' Cerrar el libro activo guardando los cambios
     ' Close the active workbook saving changes
     ActiveWorkbook.Close SaveChanges:=True

     ' Restaurar las configuraciones originales de la aplicación
     ' Restore original application settings
     Application.ScreenUpdating = True
     Application.DisplayAlerts = True
     Application.EnableEvents = True
     Application.Interactive = True

     ' Activar el libro original
     ' Activate the original workbook

     ThisWorkbook.Activate End Sub

 Public Sub ExportModules()
     ' Variables para exportar módulos de código
     ' Variables to export code modules
     Dim bExport As Boolean
     Dim wkbSource As Excel.Workbook
     Dim szSourceWorkbook As String
     Dim szExportPath As String
     Dim szFileName As String
     Dim cmpComponent As VBIDE.VBComponent

     ' Comprobar si la carpeta de destino existe
     ' Check if the destination folder exists

     If FolderWithVBAProjectFiles = "Error" Then
         MsgBox "Export Folder Not exist"
         Exit Sub
     End If

     ' Eliminar los archivos existentes en la carpeta de destino
     ' Delete existing files in the destination folder

     On Error Resume Next
     Kill FolderWithVBAProjectFiles & "\*.*"
     On Error GoTo 0

     ' Obtener el nombre del libro de origen y establecer una referencia al libro de origen
     ' Get the name of the source workbook and set a reference to the source workbook
     szSourceWorkbook = ThisWorkbook.Name
     Set wkbSource = Application.Workbooks(szSourceWorkbook)

     ' Comprobar si el proyecto VBA del libro de origen está protegido
     ' Check if the source workbook VBA project is protected
     If wkbSource.VBProject.Protection = 1 Then
         MsgBox "The VBA in this workbook Is protected," & _
                "not possible To export the code"
         Exit Sub
     End If

     ' Establecer la ruta de exportación como la carpeta de destino
     ' Set the export path as the destination folder
     szExportPath = FolderWithVBAProjectFiles & "\"

     ' Iterar a través de los componentes de VBA del libro de origen
     ' Iterate through the VBA components of the source workbook
     For Each cmpComponent In wkbSource.VBProject.VBComponents
         bExport = True
         szFileName = cmpComponent.Name

         ' Asignar la extensión de archivo adecuada según el tipo de componente
         ' Assign the appropriate file extension based on the component type
         Select Case cmpComponent.Type
             Case vbext_ct_ClassModule
                 szFileName = szFileName & ".cls"
             Case vbext_ct_MSForm
                 szFileName = szFileName & ".frm"
             Case vbext_ct_StdModule
                 szFileName = szFileName & ".bas"
             Case vbext_ct_Document
                 ' No exportar componentes de tipo Document
                 ' Do not export components of type Document
                 bExport = False
         End Select

         ' Exportar el componente si está marcado para exportación
         ' Export the component if it is marked for export
         If bExport Then
             cmpComponent.Export szExportPath & szFileName
         End If
     Next cmpComponent

     Debug.Print "Export Is ready" End Sub

 Public Sub ImportModules()
     ' Variables para importar módulos de código
     ' Variables to import code modules
     Dim wkbTarget As Excel.Workbook
     Dim objFSO As Scripting.FileSystemObject
     Dim objFile As Scripting.file
     Dim szTargetWorkbook As String
     Dim szImportPath As String
     Dim szFileName As String
     Dim cmpComponents As VBIDE.VBComponents

     ' Comprobar si el libro activo es el mismo que el libro de origen
     ' Check if the active workbook is the same as the source workbook
     If ActiveWorkbook.Name = ThisWorkbook.Name Then
         MsgBox "Select another destination workbook" & _
                "Not possible To import in this workbook "
         Exit Sub
     End If

     ' Comprobar si la carpeta de origen existe
     ' Check if the source folder exists
     If FolderWithVBAProjectFiles = "Error" Then
         MsgBox "Import Folder Not exist"
         Exit Sub
     End If

     ' Obtener el nombre del libro de destino y establecer una referencia al libro de destino
     ' Get the name of the destination workbook and set a reference to the destination workbook
     szTargetWorkbook = ActiveWorkbook.Name
     Set wkbTarget = Application.Workbooks(szTargetWorkbook)

     ' Comprobar si el proyecto VBA del libro de destino está protegido
     ' Check if the target workbook VBA project is protected
     If wkbTarget.VBProject.Protection = 1 Then
         MsgBox "The VBA in this workbook Is protected," & _
                "not possible To Import the code"
         Exit Sub
     End If

     ' Establecer la ruta de importación como la carpeta de origen
     ' Set the import path as the source folder
     szImportPath = FolderWithVBAProjectFiles & "\"

     ' Crear un objeto FileSystemObject para trabajar con archivos
     ' Create a FileSystemObject to work with files
     Set objFSO = New Scripting.FileSystemObject

     ' Comprobar si hay archivos para importar en la carpeta de origen
     ' Check if there are files to import in the source folder
     If objFSO.GetFolder(szImportPath).Files.Count = 0 Then
         MsgBox "There are no files To import"
         Exit Sub
     End If

     ' Eliminar los módulos de código y formularios de usuario existentes en el libro de destino
     ' Delete existing code modules and userforms in the target workbook
     Call DeleteVBAModulesAndUserForms

     ' Obtener una referencia a los componentes de VBA del libro de destino
     ' Get a reference to the VBA components of the target workbook
     Set cmpComponents = wkbTarget.VBProject.VBComponents

     ' Iterar a través de los archivos en la carpeta de origen
     ' Iterate through the files in the source folder
     For Each objFile In objFSO.GetFolder(szImportPath).Files
         ' Importar el archivo si tiene una extensión válida
         ' Import the file if it has a valid extension
         If (objFSO.GetExtensionName(objFile.Name) = "cls") Or _
            (objFSO.GetExtensionName(objFile.Name) = "frm") Or _
            (objFSO.GetExtensionName(objFile.Name) = "bas") Then
             cmpComponents.Import objFile.Path
         End If
     Next objFile

     Debug.Print "Import Is ready" End Sub

 Function FolderWithVBAProjectFiles() As String
     ' Función para obtener la carpeta de destino de los archivos VBA
     ' Function to get the destination folder of the VBA files
     Dim wshShell As Object
     Dim fso As Object
     Dim SpecialPath As String

     ' Crear objetos Shell y FileSystemObject
     ' Create Shell and FileSystemObject objects
     Set wshShell = CreateObject("WScript.Shell")
     Set fso = CreateObject("scripting.filesystemobject")

     ' Obtener la ruta de la carpeta "Mis documentos"
     ' Get the path of the "My Documents" folder
     SpecialPath = wshShell.SpecialFolders("MyDocuments")

     ' Agregar una barra diagonal si no está presente al final de la ruta
     ' Add a forward slash if not present at the end of the path
     If Right(SpecialPath, 1) <> "\" Then
         SpecialPath = SpecialPath & "\"
     End If

     ' Crear la carpeta "VBAProjectFiles" si no existe
     ' Create the folder "VBAProjectFiles" if it doesn't exist

     If fso.FolderExists(SpecialPath & "VBAProjectFiles") = False Then
         On Error Resume Next
         MkDir SpecialPath & "VBAProjectFiles"
         On Error GoTo 0
     End If

     ' Devolver la ruta de la carpeta "VBAProjectFiles" si existe, o "Error" si no existe
     ' Return the path of the "VBAProjectFiles" folder if it exists, or "Error" if it doesn't
     If fso.FolderExists(SpecialPath & "VBAProjectFiles") = True Then
         FolderWithVBAProjectFiles = SpecialPath & "VBAProjectFiles"
     Else
         FolderWithVBAProjectFiles = "Error"
     End If End Function

 Function DeleteVBAModulesAndUserForms()
     ' Función para eliminar los módulos de código y formularios de usuario existentes
     ' Function to remove existing code modules and userforms
     Dim VBProj As VBIDE.VBProject
     Dim vbComp As VBIDE.VBComponent

     ' Obtener una referencia al proyecto VBA del libro activo
     ' Get a reference to the VBA project of the active workbook
     Set VBProj = ActiveWorkbook.VBProject

     ' Iterar a través de los componentes de VBA en el proyecto
     ' Iterate through the VBA components in the project

     For Each vbComp In VBProj.VBComponents
         ' Eliminar el componente si no es de tipo Document
         ' Delete the component if it is not of type Document
         If vbComp.Type = vbext_ct_Document Then
         Else
             VBProj.VBComponents.Remove vbComp
         End If
     Next vbComp End Function

相关问题