2014-10-03 68 views
0

我有下面的代碼,我正在運行,以控制Excel中的表單的行爲,當用戶單擊提交這會發送兩封電子郵件,並重置我的工作表上的單元格中的一些值和公式。然而,當這運行我得到一個1004錯誤的應用程序未定義或應用程序定義的錯誤,我不知道這是爲什麼?vba 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 [email protected] 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 = "[email protected]" 
     .To = "[email protected]" 
     .CC = "[email protected]" 
     .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 [email protected] 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 = "[email protected]" 
     .To = Range("H22").Value 
     .CC = "[email protected]" 
     .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 
+0

你添加哪些對象,使得這錯誤出現在哪裏? – BradyK 2014-10-03 13:06:11

+1

如果在出現錯誤時單擊「調試」,哪一行會突出顯示? – 2014-10-03 13:34:28

回答

0

的問題是在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)),"""")" 
相關問題