Question

我运行以下代码来控制excel中表单的行为，当用户单击“提交”时，它会发送两封电子邮件并重置我工作表单元格中的某些值和公式。但是当这个运行时，我得到一个1004错误应用程序未定义或应用程序定义错误，我不知道为什么会这样？

有人可以帮我找到问题的原因。

我认为受影响的部分代码是：

 Application.ScreenUpdating = False



    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim DestRow As Long
    Set ws1 = Sheets("Home")
    Set ws2 = Sheets("Statistics")

     ws1.Range("B10").Value = ""
     ws1.Range("B15").Value = ""
     ws1.Range("B20").Value = ""
     ws1.Range("H10").Value = ""
     ws1.Range("H15").Value = ""
     ws1.Range("H20").Value = ""
     ws1.Range("N10").Formula = "=IFERROR(INDEX('Depot Data'!$F$1:$F$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)),"")"
     ws1.Range("N15").Formula = "=IFERROR(INDEX('Depot Data'!$H$1:$H$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)),"")"
     ws1.Range("B32").Formula = "=IF(C32=""Yes"",B34,IF(ISTEXT(B10),CONCATENATE(""NS"")&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9),""""))"
     ws1.Range("B34").Formula = "=IF(C34 <>""Yes"",B32,B34)"
     ws1.Range("N20").Formula = "=IF(ISTEXT(B10),NOW(),"""")"
     ws1.Range("H32").Formula = "=IF(ISTEXT(B10),""Awaiting Manager Approval"","""")"
     ws1.Range("N32").Formula = "=IF(ISTEXT(B10),""Request to be Reviewed"","""")"



    Set InfoBox = CreateObject("WScript.Shell")
    'Set the message box to close after 10 seconds
    AckTime = 1
    Select Case InfoBox.Popup("Thank You" & vbNewLine & "Your request has been successfully submitted.", _
    AckTime, "Thank You", 0)
        Case 1, -1
    End Select


End If
End If
End Sub

将我的所有代码放在一起。

提前致谢！

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.DisplayAlerts = False
If Target.Column = Range("Z1").Column And Range("Z" & ActiveCell.Row).Value = "SUBMIT" Then
If Range("B10").Value = "" Or Range("B15").Value = "" Or Range("B20").Value = "" Or Range("H10").Value = "" Or Range("H15").Value = "" Or Range("H20").Value = "" Or Range("N10").Value = "" Or Range("N15").Value = "" Or Range("N20").Value = "" Then
Dim AckTime As Integer, InfoBox As Object
    Set InfoBox = CreateObject("WScript.Shell")
    'Set the message box to close after 10 seconds
    AckTime = 1
    Select Case InfoBox.Popup("Ooops!" & vbNewLine & vbNewLine & "We can't submit this form," & vbNewLine & "you did not complete all the required information.", _
    AckTime, "Cannot Submit the Form!", 0)
        Case 1, -1
    End Select

ElseIf Target.Column = Range("Z1").Column And Range("Z" & ActiveCell.Row).Value = "SUBMIT" And Range("B10").Value <> "" Then

Dim AckTime2 As Integer, InfoBox2 As Object
    Set InfoBox2 = CreateObject("WScript.Shell")
    'Set the message box to close after 10 seconds
    AckTime2 = 1
    Select Case InfoBox2.Popup("Please Wait" & vbNewLine & "We are dealing with your request.", _
    AckTime2, "Please Wait", 0)
        Case 1, -1
    End Select

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    TempFilePath = "\\UKSH000-File06\Purchasing\New_Supplier_Set_Ups_&_Audits\assets\"

    strbody = "<p style='color:#000;font-family:calibri;font-size:16'>Dear Purchasing Admin," & vbNewLine & vbNewLine & _
              "<br><br>" & "This is an automated email, sent to you from New Suppliers." & vbNewLine & _
              "<br>" & "You have a New Supplier Set-Up Request. Please find the details of the application listed below:" & vbNewLine & vbNewLine & _
              "<br><br><b>" & "Company Name: " & "</b>" & Range("B10").Value & vbNewLine & _
              "<br><b>" & "Company Number: " & "</b>" & Range("B15").Value & vbNewLine & _
              "<br><b>" & "Case Reference: " & "</b>" & Range("B32").Value & vbNewLine & _
              "<br><br><b>" & "Description of the provisional Supplier: " & "</b>" & "<br>" & Range("B20").Value & vbNewLine & _
              "<br><br><b>" & "Current Status: " & "</b>" & Range("Y7").Value & vbNewLine & vbNewLine & _
              "<br><b>" & "Request By: " & "</b>" & Range("H15").Value & vbNewLine & vbNewLine & _
              "<br><b>" & "Allocated Manager: " & "</b>" & Range("N10").Value & vbNewLine & vbNewLine & _
              "<br><b>" & "Allocated Depot " & "</b>" & Range("N15").Value & vbNewLine & vbNewLine & _
              "<br><br><br>" & "Note:" & vbNewLine & _
              "<br>" & "Please keep a note of your reference number in the event you should have any enquiries. All enquiries should be emailed to NewSuppliers@Hewden.co.uk and you should quote your reference number." & vbNewLine & vbNewLine & _
              "<br><br>" & "Kind Regards," & "</font></p>" & vbNewLine & _
              "<p style='color:#000;font-family:calibri;font-size:18'><b>Automated Purchasing Email</font></p></b>" & vbNewLine & _
              "<br><br><img src='cid:cover.jpg'" & "width='800' height='64'><br>" & vbNewLine & _
              "<img src='cid:subs.jpg'" & "width='274' height='51'>"


    With OutMail
        .SentOnBehalfOfName = "newsuppliers@hewden.co.uk"
        .To = "newsuppliers@hewden.co.uk"
        .CC = "supplieraudits@hewden.co.uk"
        .BCC = ""
        .Subject = "New Supplier Request - Reference: " & Range("B32").Value & ""
        .Attachments.Add TempFilePath & "cover.jpg", olByValue, 0
        .Attachments.Add TempFilePath & "subs.jpg", olByValue, 0
        .HTMLBody = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .send   'or use .Display
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    TempFilePath = "\\UKSH000-File06\Purchasing\New_Supplier_Set_Ups_&_Audits\assets\"

    strbody = "<p style='color:#000;font-family:calibri;font-size:16'>Dear " & Range("H15").Value & "," & vbNewLine & vbNewLine & _
              "<br><br>" & "This is an automated email, sent to you by the purchasing department." & vbNewLine & _
              "<br>" & "This is to confirm that we have successfully received your New Supplier Set-Up Request. Whilst we endeavour to complete your supplier request within 3-5 days, please allow upto 10 days for this process to be compelted, the process can be delayed if information is missing or incomplete. That's it for now, you don't need to do anything else, we are carrying out some checks on this supplier and will gather the information we need. We will keep you up to date on the status of your New Supplier Request by email. Please see the information below for your reference." & vbNewLine & vbNewLine & _
              "<br><br><b>" & "Supplier Name: " & "</b>" & Range("B10").Value & vbNewLine & _
              "<br><b>" & "Case Reference Number: " & "</b>" & Range("B32").Value & vbNewLine & _
              "<br><b>" & "Supplier Status: " & "</b>" & Range("Y7").Value & vbNewLine & vbNewLine & _
              "<br><br>" & "Note:" & vbNewLine & _
              "<br>" & "Please keep a note of your reference number in the event you should have any enquiries. All enquiries should be emailed to NewSuppliers@Hewden.co.uk and you should quote your reference number." & vbNewLine & vbNewLine & _
              "<br><br>" & "Kind Regards," & "</font></p>" & vbNewLine & _
              "<p style='color:#000;font-family:calibri;font-size:18'><b>Automated Purchasing Email</font></p></b>" & vbNewLine & _
              "<br><br><img src='cid:cover.jpg'" & "width='800' height='64'><br>" & vbNewLine & _
              "<img src='cid:subs.jpg'" & "width='274' height='51'>"


    With OutMail
        .SentOnBehalfOfName = "newsuppliers@hewden.co.uk"
        .To = Range("H22").Value
        .CC = "supplieraudits@hewden.co.uk"
        .BCC = ""
        .Subject = "New Supplier Request - Reference: " & Range("B32").Value & ""
        .Attachments.Add TempFilePath & "cover.jpg", olByValue, 0
        .Attachments.Add TempFilePath & "subs.jpg", olByValue, 0
        .HTMLBody = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .send   'or use .Display
    End With

    Application.ScreenUpdating = False



    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim DestRow As Long
    Set ws1 = Sheets("Home")
    Set ws2 = Sheets("Statistics")

     ws1.Range("B10").Value = ""
     ws1.Range("B15").Value = ""
     ws1.Range("B20").Value = ""
     ws1.Range("H10").Value = ""
     ws1.Range("H15").Value = ""
     ws1.Range("H20").Value = ""
     ws1.Range("N10").Formula = "=IFERROR(INDEX('Depot Data'!$F$1:$F$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)),"")"
     ws1.Range("N15").Formula = "=IFERROR(INDEX('Depot Data'!$H$1:$H$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)),"")"
     ws1.Range("B32").Formula = "=IF(C32=""Yes"",B34,IF(ISTEXT(B10),CONCATENATE(""NS"")&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9),""""))"
     ws1.Range("B34").Formula = "=IF(C34 <>""Yes"",B32,B34)"
     ws1.Range("N20").Formula = "=IF(ISTEXT(B10),NOW(),"""")"
     ws1.Range("H32").Formula = "=IF(ISTEXT(B10),""Awaiting Manager Approval"","""")"
     ws1.Range("N32").Formula = "=IF(ISTEXT(B10),""Request to be Reviewed"","""")"



    Set InfoBox = CreateObject("WScript.Shell")
    'Set the message box to close after 10 seconds
    AckTime = 1
    Select Case InfoBox.Popup("Thank You" & vbNewLine & "Your request has been successfully submitted.", _
    AckTime, "Thank You", 0)
        Case 1, -1
    End Select


End If
End If
End Sub

Answer 1

问题出在您的Excel公式中：

ws1.Range("N10").Formula = "=IFERROR(INDEX('Depot Data'!$F$1:$F$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)),"")"

您的引号内有引号。 VBA看到： "=IFERROR(INDEX('Depot Data'!$F$1:$F$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)),"和")"并且不知道你为什么要将它们彼此相邻。您需要为内部引号使用字符代码chr(34)，或者将它们加倍以便正确转义

ws1.Range("N10").Formula = "=IFERROR(INDEX('Depot Data'!$F$1:$F$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)), " & chr(34) & chr(34) & ")"

或

ws1.Range("N10").Formula = "=IFERROR(INDEX('Depot Data'!$F$1:$F$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)),"""")"

vba 1004应用程序未定义或应用程序定义错误？

1 个答案: