excel - VBA Excel : “Automation Error. Exception occurred.” when using UserForm-6ren

excel - VBA Excel : “Automation Error. Exception occurred.” when using UserForm

转载作者：行者123 更新时间：2023-12-04 22:27:49

几天我发了这篇文章，但代码更少，我尝试了一些新的东西(不成功)。

我的代码将数据从一张纸复制到另一张纸。共有 12 个工作簿，每个工作簿从 6 个工作簿中获取数据。

第一步是我向用户展示一个用户窗体，他们可以在其中选择一年和一个季度。代码本身在以下情况下有效:

我省略了用户表单并输入日期(= 变量 qVar ，yVar和 fullDate ) 直接在代码中。

我离开了用户窗体，但将工作簿的数量从 12 个减少了
到 7 左右。

如果我将用户窗体与所有 12 个工作簿一起使用，我会得到

“自动化错误。发生异常。”

重要提示:调试不起作用，因为当我使用 F8 浏览代码时，它可以正常工作。

有问题的用户表单

选项显式

'=================UserForm causing problems==============
Private Sub cmdAbbrechen_Click()
    Unload Me
End Sub

Private Sub cmdOk_Click()
    Dim QuartalStr As String
    Dim oControl As Control

    If cboJahr.Value = "" Then
        MsgBox "Bitte Jahr auswählen"
        Exit Sub
    End If

    For Each oControl In frmQuartalsauswahl.fraQuartale.Controls
        If oControl.Value = True Then
            qVar = oControl.Caption
        End If
    Next oControl

    yVar = CStr(cboJahr.Value)

    Select Case qVar
        Case "Q1"
            fullDate = yVar & ".03.31"
        Case "Q2"
            fullDate = yVar & ".06.30"
        Case "Q3"
            fullDate = yVar & ".09.30"
        Case "Q4"
            fullDate = yVar & ".12.31"
    End Select

    Unload Me
    Call MitUserForm.Quartalsbericht
End Sub


Private Sub UserForm_Initialize()
    Dim yearsArray() As Integer
    Dim startyear As Integer
    Dim i As Integer

    startyear = 2017
    i = 0

    Do While startyear <= Year(Date)
        ReDim Preserve yearsArray(i)
        yearsArray(i) = startyear
        startyear = startyear + 1
        i = i + 1
    Loop
    cboJahr.List = yearsArray
End Sub

错误处理用户表单

Option Explicit

Private Sub cmdCancel_Click()
    Unload Me
    End
End Sub

Private Sub cmdContinue_Click()
    Unload Me
End Sub

Private Sub cmdContinueNoSave_Click()
    saveVar = False
    Unload Me
End Sub

Private Sub UserForm_Initialize() 'frmFehler
    Me.txtFehlermeldung.Text = Join(ErrorArray, ", ")
End Sub

实际代码

Option Explicit

Public fullDate As String
Public yVar As Long
Public qVar As String
Public saveVar As Boolean

Sub ShowUserformQuartal()
    frmQuartalsauswahl.Show
End Sub

Sub Quartalsbericht()

    Dim VWNumberReal As String
    Dim ErrorMessage As String
    Dim Item As Variant
    Dim FilePath As String
    Dim ErrorCount As Long

'code works if I set date like this:
'yVar = 2018
'qVar = "Q4"
'fullDate = "2018.12.31"


Dim VWArray As Variant
Dim FondsArray As Variant
Dim rng As Range, rngHeader As Range
Dim wbVWQB As Workbook, wb As Workbook
Dim wsVWQB As Worksheet
Dim lCol As Long, lColNew As Long
Dim FondsArt As Variant, VWNumber As Variant
Dim wbClose As Workbook


FilePath = "H:\Report\"

VWArray = Array("21", "21FV", "25", "35", "45", "46", "49", "51", "52", "53", "54", "101")


    saveVar = True
'======================Do files exist?=====================
    For Each VWNumber In VWArray
        If Dir$(FilePath & VWNumber & "Quartalsbericht.xlsx") = "" Then
            ErrorMessage = "Quartalsbericht" & VWNumber
            ReDim Preserve ErrorArray(ErrorCount)
            ErrorArray(ErrorCount) = ErrorMessage
            ErrorCount = ErrorCount + 1
        End If

        If VWNumber = "21FV" Then
            FondsArray = Array("AnlFonds", "AnlMischung", "NW670", "FVNW671", "NW673")
            VWNumber = "21"
            VWNumberReal = "21FV"
        ElseIf VWNumber = "49" Then
            FondsArray = Array("AnlFonds", "AnlMischung", "AnlStreuung", "NW670", "NW671", "NW673")
        ElseIf qVar = "Q4" Then
            FondsArray = Array("AnlFonds", "AnlMischung", "AnlStreuung", "NW670", "NW671", "NW673")
        Else
            FondsArray = Array("AnlFonds", "AnlMischung", "AnlStreuung", "NW670", "NW673")
        End If

        For Each FondsArt In FondsArray

            If Dir$(FilePath & yVar & "\" & fullDate & "\" & VWNumber & FondsArt & qVar & yVar & ".xlsx") = "" Then
                ErrorMessage = VWNumber & FondsArt & qVar & yVar
                ReDim Preserve ErrorArray(ErrorCount)
                ErrorArray(ErrorCount) = ErrorMessage
                ErrorCount = ErrorCount + 1
            End If
        Next FondsArt
    Next VWNumber

If ErrorCount > 0 Then
    frmFehler.Show
End If

Application.ScreenUpdating = False
        For Each VWNumber In VWArray
            If Dir$(FilePath & VWNumber & "Quartalsbericht.xlsx") = "" Then
                GoTo MissingVWFile
            End If

                Set wbVWQB = Application.Workbooks.Open(FilePath & VWNumber & "Quartalsbericht.xlsx")
                wbVWQB.SaveAs FilePath & "Backups\" & VWNumber & "Quartalsbericht_old_" & Format(Now(), "dd-mm-yyyy hh-mm-ss") & ".xlsx"  'backup
                Application.DisplayAlerts = False ' = automatisches Überschreiben der alten Datei
                wbVWQB.SaveAs FilePath & VWNumber & "Quartalsbericht.xlsx" 'ursprünglicher Name, so dass workbooks außerhalb des Loops gespeichert werden können
                Application.DisplayAlerts = True

                If VWNumber = "21FV" Then
                    Debug.Print "Fall 1: " & VWNumber
                    FondsArray = Array("AnlFonds", "AnlMischung", "NW670", "FVNW671", "NW673")
                ElseIf VWNumber = "49" Then
                    Debug.Print "Fall 2: " & VWNumber
                    FondsArray = Array("AnlFonds", "AnlMischung", "AnlStreuung", "NW670", "NW671", "NW673")
                ElseIf qVar = "Q4" Then
                    Debug.Print "Fall 3: " & VWNumber
                    FondsArray = Array("AnlFonds", "AnlMischung", "AnlStreuung", "NW670", "NW671", "NW673")
                Else
                    Debug.Print "Fall 4: " & VWNumber
                    FondsArray = Array("AnlFonds", "AnlMischung", "AnlStreuung", "NW670", "NW673")
                End If

            If VWNumber = "21FV" Then
                VWNumberReal = "21FV"
                VWNumber = "21"
            End If
            Debug.Print "If VW Number = 21FV: Real: " & VWNumberReal & " VWNumber: " & VWNumber


            For Each FondsArt In FondsArray
                If Dir$(FilePath & yVar & "\" & fullDate & "\" & VWNumber & FondsArt & qVar & yVar & ".xlsx") = "" Then
                    GoTo MissingFondsFile
                End If

                Set wb = Application.Workbooks.Open(FilePath & yVar & "\" & fullDate & "\" & VWNumber & FondsArt & qVar & yVar & ".xlsx")
                Set wsVWQB = wbVWQB.Sheets(FondsArt)

                lCol = wsVWQB.Cells(2, Columns.Count).End(xlToLeft).Column + 1

                If VWNumberReal <> "21FV" Then
                    Select Case wb.Name
                        Case VWNumber & "AnlFonds" & qVar & yVar & ".xlsx"
                            If VWNumber = "21" Then
                                wb.ActiveSheet.Range("E1:E1").Copy wbVWQB.Sheets(FondsArt).Cells(2, lCol)
                                wb.ActiveSheet.Range("E31:E118").Copy: wbVWQB.Sheets(FondsArt).Cells(3, lCol).PasteSpecial xlPasteAllUsingSourceTheme
                            Else
                                wb.ActiveSheet.Range("D1").Copy wbVWQB.Sheets(FondsArt).Cells(2, lCol)
                                wb.ActiveSheet.Range("D31:D118").Copy: wbVWQB.Sheets(FondsArt).Cells(3, lCol).PasteSpecial xlPasteAllUsingSourceTheme
                            End If
                        Case VWNumber & "AnlMischung" & qVar & yVar & ".xlsx"
                            wb.ActiveSheet.Range("E1:F200").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol).PasteSpecial xlPasteAllUsingSourceTheme
                        Case VWNumber & "AnlStreuung" & qVar & yVar & ".xlsx"
                            lCol = wsVWQB.Cells(3, Columns.Count).End(xlToLeft).Column + 1
                            wb.ActiveSheet.Range("A9:G200").Copy: wbVWQB.Sheets(FondsArt).Cells(3, lCol).PasteSpecial xlPasteAllUsingSourceTheme
                        Case VWNumber & "NW670" & qVar & yVar & ".xlsx"
                            wb.ActiveSheet.Range("C1:C200").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol).PasteSpecial xlPasteAllUsingSourceTheme
                        Case VWNumber & "NW671" & qVar & yVar & ".xlsx"
                            wb.ActiveSheet.Range("C1:F1").Copy wbVWQB.Sheets(FondsArt).Cells(2, lCol)
                            wb.ActiveSheet.Range("C46:F200").Copy: wbVWQB.Sheets(FondsArt).Cells(3, lCol).PasteSpecial xlPasteAllUsingSourceTheme
                        Case VWNumber & "FVNW671" & qVar & yVar & ".xlsx"
                            wb.ActiveSheet.Range("C1:F1").Copy wbVWQB.Sheets(FondsArt).Cells(2, lCol)
                            wb.ActiveSheet.Range("C46:F200").Copy: wbVWQB.Sheets(FondsArt).Cells(3, lCol).PasteSpecial xlPasteAllUsingSourceTheme
                        Case VWNumber & "NW673" & qVar & yVar & ".xlsx"
                            wb.ActiveSheet.Range("C1:C100").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol).PasteSpecial xlPasteAllUsingSourceTheme
                            wb.ActiveSheet.Range("F1:F100").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol + 1).PasteSpecial xlPasteAllUsingSourceTheme
                    End Select
                Else 'VWNumberReal = "21FV"
                    Select Case wb.Name
                        Case VWNumber & "AnlFonds" & qVar & yVar & ".xlsx"
                            wb.ActiveSheet.Range("D1").Copy wbVWQB.Sheets(FondsArt).Cells(2, lCol)
                            wb.ActiveSheet.Range("D31:D118").Copy: wbVWQB.Sheets(FondsArt).Cells(3, lCol).PasteSpecial xlPasteAllUsingSourceTheme
                        Case VWNumber & "AnlMischung" & qVar & yVar & ".xlsx"
                            wb.ActiveSheet.Range("C1:D200").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol).PasteSpecial xlPasteAllUsingSourceTheme
                        Case VWNumber & "NW670" & qVar & yVar & ".xlsx"
                            wb.ActiveSheet.Range("D1:D200").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol).PasteSpecial xlPasteAllUsingSourceTheme
                        Case VWNumber & "FVNW671" & qVar & yVar & ".xlsx"
                            wb.ActiveSheet.Range("C1:F1").Copy wbVWQB.Sheets(FondsArt).Cells(2, lCol)
                            wb.ActiveSheet.Range("C46:F200").Copy: wbVWQB.Sheets(FondsArt).Cells(3, lCol).PasteSpecial xlPasteAllUsingSourceTheme
                        Case VWNumber & "NW673" & qVar & yVar & ".xlsx"
                            wb.ActiveSheet.Range("D1:D100").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol).PasteSpecial xlPasteAllUsingSourceTheme
                            wb.ActiveSheet.Range("F1:F100").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol + 1).PasteSpecial xlPasteAllUsingSourceTheme
                    End Select
                End If


                If FondsArt = "AnlStreuung" Then
                    lColNew = wsVWQB.Cells(3, Columns.Count).End(xlToLeft).Column
                    wsVWQB.Range(wsVWQB.Cells(2, lCol), wsVWQB.Cells(2, lColNew)).Interior.Color = RGB(128, 128, 128) 'grey (empty) header
                Else
                    lColNew = wsVWQB.Cells(2, Columns.Count).End(xlToLeft).Column
                End If

                'year and quarter as headline
                With wsVWQB
                    .Range(.Cells(1, lCol), .Cells(1, lColNew)).Merge
                    .Cells(1, lCol).Value = qVar & " " & yVar
                    .Cells(1, lCol).HorizontalAlignment = xlCenter
                    .Cells(1, lCol).Font.Bold = True
                    .Cells(1, lCol).Font.Color = vbWhite
                    .Cells(1, lCol).Interior.Color = RGB(128, 128, 128)
                    .Range(.Cells(2, lCol), .Cells(2, lColNew)).Font.Bold = True
                    .Range(.Cells(2, lCol), .Cells(2, lColNew)).Font.Color = vbWhite
                End With

                Call LeftBorder(lCol, wbVWQB, wsVWQB)

                wb.Close SaveChanges:=False
MissingFondsFile:
            VWNumberReal = ""
            Next FondsArt
            wbVWQB.Close SaveChanges:=saveVar
            Application.CutCopyMode = False
MissingVWFile:
        Next VWNumber

Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub

Sub LeftBorder(lCol As Long, wbVWQB As Workbook, wsVWQB As Worksheet)
    Dim lRow As Long
    Debug.Print wsVWQB.Name
    Debug.Print lCol

    With wsVWQB
        Select Case .Name
            Case "AnlMischung"
                .Range(.Cells(1, lCol), .Cells(63, lCol)).Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Range(.Cells(1, lCol), .Cells(63, lCol)).Borders(xlEdgeLeft).Weight = xlThick
            Case "AnlStreuung"
                 lRow = .Cells(Rows.Count, lCol + 6).End(xlUp).Row
                .Range(.Cells(1, lCol), .Cells(lRow, lCol)).Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Range(.Cells(1, lCol), .Cells(lRow, lCol)).Borders(xlEdgeLeft).Weight = xlThick
            Case "NW671"
                .Range(.Cells(1, lCol), .Cells(73, lCol)).Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Range(.Cells(1, lCol), .Cells(73, lCol)).Borders(xlEdgeLeft).Weight = xlThick
            Case "FVNW671"
                .Range(.Cells(1, lCol), .Cells(73, lCol)).Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Range(.Cells(1, lCol), .Cells(73, lCol)).Borders(xlEdgeLeft).Weight = xlThick
            Case "NW673"
                .Range(.Cells(1, lCol), .Cells(50, lCol)).Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Range(.Cells(1, lCol), .Cells(50, lCol)).Borders(xlEdgeLeft).Weight = xlThick
        End Select
    End With
End Sub

最初我打开了 12 个工作簿，我认为这可能会导致问题，但是对于我的代码的新版本，我可以说它没有。

最佳答案

我想我找到了解决方案。几个月来打开一个用户窗体而没有首先在 VBA 编辑器中打开窗体会使整个程序陷入困境。
Another thread指出 Excel 更改为并行加载表单，因此当一个部分先于另一个完成时，会导致整个过程崩溃。几乎就像你的 friend 在他们还在 3 个街区外时给你发短信一样，如果你在他们到达你家之前就出去，你就会死。无论如何。
如果您使用按钮调用用户窗体，请将其添加到 Button_click()子。

ThisWorkbook.VBProject.VBComponents("UserForm").Activate

它告诉 Excel 在您单击按钮后立即加载表单，而不是先加载进入表单的所有内容。这与打开 VBA 窗口的作用基本相同。
希望这可以帮助!

关于excel - VBA Excel : “Automation Error. Exception occurred.” when using UserForm，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/56172576/

文章推荐： regex - 如何为 GIIN 格式验证创建正则表达式 VBA 宏

文章推荐： excel - VBA 代码 - 连接到网页并检索值

文章推荐： C# 数组仅将第一个数组项重复到 excel 字段中

rust - 如何将 serde_json::error::Error 转换为 reqwest::error::Error？
reqwest v0.9 将 serde v1.0 作为依赖项，因此实现 converting serde_json errors into reqwest error . 在我的代码中，我使用 se
error-handling - 有没有办法将 std::io::Error 转换为 failure::error::Error？
我有这个代码: let file = FileStorage { // ... }; file.write("Test", bytes.as_ref()) .map_err(|e| Mu
角度攀登: Error: No errors
我只是尝试用angular-cli创建一个新项目，然后运行服务器，但是它停止并显示一条有趣的消息:Error: No errors。我以这种方式更新了(希望有帮助):npm uninstall -g
payload - 我收到错误 : "MetaMask - RPC Error: Error: Error: [ethjs-rpc] rpc error with payload"
我从我的 javascript 发送交易 Metamask 打开传输对话框我确定 i get an error message in metamask (inpage.js:1 MetaMask -
error-handling - 使用 Box 装箱后如何处理不同的错误类型？
这个问题在这里已经有了答案: How do you define custom `Error` types in Rust? (3 个答案) How to get a reference to a
swift - error = error 与 error != nil 之间的区别
我想知道两者之间有什么大的区别 if let error = error{} vs if error != nil?或者只是人们的不同之处，比如他们如何用代码表达自己？例如，如果我使用这段代码: u
blazor - 错误 : Connection disconnected with error 'Error: Server returned an error on close: Connection closed with an error.'
当我尝试发送超过 50KB 的图像时，我在 Blazor 服务器应用程序上收到以下错误消息 Error: Connection disconnected with error 'Error: Serv
jsf - JSF : error handling with and JSF1073 error
我有一个error-page指令，它将所有异常重定向到错误显示页面我的web.xml: [...] java.lang.Exception /vi
node.js - 如何修复 'error: Error: syntax error - at value'
我有这样的对象: address: { "phone" : 888, "value" : 12 } 在 WHERE 中我需要通过 address.value 查找对象，但是在 SQL 中有函数
c++ - '标识符' : redefinition errors ( error C2011 & error C2370)
每次我尝试编译我的代码时，我都会遇到大量错误。这不是我的代码的问题，因为它在另一台计算机上工作得很好。我尝试重新安装和修复，但这没有帮助。这是整个错误消息: 1>------ Build starte
error-handling - Bison : one error causes additional but incorrect error
在我的代码的类部分，如果我写一个错误，则在不应该的情况下，将有几行报告为错误。我将'| error'放在可以从错误中恢复的良好/安全位置，但是我认为它没有使用它。也许它试图在某个地方恢复中间表情？有
Python捕获异常 "pandas.errors.ParserError: Error tokenizing data. C error"
我遇到了 csv 输入文件整体读取故障的问题，我可以通过在 read_csv 函数中添加 "error_bad_lines=False" 来删除这些问题来解决这个问题。但是我需要报告这些造成问题的文
java - Spring : How to resolve a validation error -> error code -> error message
在 Spring 中，验证后我们在 controller 中得到一个 BindingResult 对象。很简单，如果我收到验证错误，我想重新显示我的表单，并在每个受影响的字段上方显示错误消息。因此
eclipse - Java 运行时环境检测到 fatal error : Internal Error ; Error: ShouldNotReachHere()
我不知道出了什么问题，因为我用 Java 编程了大约一年，从来没有遇到过这个错误。在一分钟前在 Eclipse 中编译和运行工作，现在我得到这个错误: #A fatal error has been
postgresql - Postgres : Error [42601] Error: Syntax error at or near "$2". 执行查询时出错
SELECT to_char(messages. TIME, 'YYYY/MM/DD') AS FullDate, to_char(messages. TIME, 'MM/DD
.net - VB.NET : error BC30037, followed by error BC30627 and error BC30465
我收到这些错误: AnonymousPath\Anonymized.vb : error BC30037: Character is not valid. AnonymousPath\Anonymiz
sungridengine - 网格引擎 : error: commlib error: got select error (connection refused)
我刚刚安装了 gridengine 并在执行 qstat 时出现错误: error: commlib error: got select error (Connection refused) erro
php - 尖叫 : Error suppresion ignored for Parse error: syntax error PHP
嗨，我正在学习 PHP，我从 CRUD 系统开始，我在 Windows 上安装了 WAMP 服务器，当我运行它时，我收到以下错误消息。 SCREAM: Error suppression ignore
swift - fatal error : Unresolved error Error Domain=NSCocoaErrorDomain Code=134140
我刚刚开始一个新项目，我正在学习核心数据教程，可以找到:https://www.youtube.com/watch?v=zZJpsszfTHM 我似乎无法弄清楚为什么会抛出此错误。我有一个名为“Exp
c++ - JENKINS BUILD ERROR fatal error C1853 : precompiled header error
当我使用 Jenkins 运行新构建时，出现以下错误: "FilePathY\XXX.cpp : fatal error C1853: 'FilePathZ\XXX.pch' precompiled

行者123

个人简介

我是一名优秀的程序员,十分优秀！

作者热门文章

滴滴打车优惠券免费领取

全站热门文章

首页

博学

6Ren·AI

商城

excel - VBA Excel : “Automation Error. Exception occurred.” when using UserForm