2017-06-14 77 views
0

嘗試將兩個模塊合併到Excel表中,並遇到我無法診斷的問題。獨立模塊工作,但當兩者都在文件中時,它給我一個「編譯錯誤:錯誤的參數數量或無效的屬性分配」與調試中突出顯示的Sub行。我不知道進一步診斷,希望能在這裏得到一些指導。添加額外的VBA模塊會在運行以前的工作模塊時產生編譯錯誤

模塊1 - 創建新的文件和電子郵件

Dim fPO As String 
    Dim fDate As Date 
    Dim fPath As String 
    Dim POFile As String 
    Dim Template As String 
    Dim yearfolder As String 
    Dim monthfolder As String 
    Dim newfolderpath As String 
    Dim FileName As String 

Sub CreatePOFile() 
' 
' Creates new file for each PO 
' 

' 


    fPO = Range("C4").Value 
    fDate = Date - 3 'adjust to change date used in file name 
    fPath = "\\Kforce.com\Group\TAMPA\CORP\Strategic Accounts\Strategic Accounts Operations\CLIENT REPORTS\HP\HP Weekly PO Reporting" 'adjust where file is saved 
    Template = ActiveWorkbook.Name 
    monthfolder = Format(fDate, "mm. mmmm YYYY") 
    yearfolder = Format(fDate, "YYYY") 
    newfolderpath = fPath & "\" & yearfolder & "\" & monthfolder 
    FileName = fPO & " Weekly Report as of " & Format(fDate, "yyyymmdd") 

' 
' 
' 

    'Format pivot table header 
    Rows("7:7").Select 
    With Selection 
     .HorizontalAlignment = xlCenter 
    End With 

    'Create new workbook and save individual PO file. Creates new folders if nonexistant 
    Workbooks.Add 

    If Len(Dir(fPath & "\" & yearfolder, vbDirectory)) = 0 Then 
     MkDir fPath & "\" & yearfolder 
    End If 
    If Len(Dir(fPath & "\" & yearfolder & "\" & monthfolder, vbDirectory)) = 0 Then 
     MkDir fPath & "\" & yearfolder & "\" & monthfolder 
    End If 

    ActiveWorkbook.SaveAs FileName:=newfolderpath & "\" & FileName, FileFormat:=51 
    Application.DisplayAlerts = True 

    POFile = ActiveWorkbook.Name 

    'Copy Pivot information to new file 
    Windows(Template).Activate 
    Range("B7").Select 
    ActiveCell.CurrentRegion.Select 
    Selection.SpecialCells(xlCellTypeVisible).Select 
    Selection.Copy 
    Range("A1").Select 

    Windows(POFile).Activate 
    Range("B7").Select 
    ActiveSheet.Paste 

    ActiveSheet.Name = fPO 

    'Formatting PO File and adding information fields 
    Range("B2").Select 
    ActiveCell.FormulaR1C1 = "Weekly PO Report" 
    With Selection.Font 
    .Name = "Calibri Light" 
     .Size = 18 
     .Strikethrough = False 
     .Superscript = False 
     .Subscript = False 
     .OutlineFont = False 
     .Shadow = False 
     .Underline = xlUnderlineStyleNone 
     .ThemeColor = xlThemeColorLight2 
     .TintAndShade = 0 
     .ThemeFont = xlThemeFontMajor 
    End With 

    Range("B4").Value = "PO Number:" 
    Range("B5").Value = "Date Range:" 

    Range("B4:B5").Select 
    With Selection 
     .Interior.Pattern = xlSolid 
     .Interior.PatternColorIndex = xlAutomatic 
     .Interior.ThemeColor = xlThemeColorAccent2 
     .Interior.TintAndShade = 0 
     .Interior.PatternTintAndShade = 0 
     .Font.ThemeColor = xlThemeColorDark1 
     .Font.TintAndShade = 0 
     .HorizontalAlignment = xlCenter 
     .VerticalAlignment = xlBottom 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 

    Range("C4").Value = fPO 
    Range("C5").FormulaR1C1 = "=TEXT(MIN(C[-1]),""m/d/yyyy"")&"" - ""&TEXT(MAX(C[-1]),""m/d/yyyy"")" 
    Range("C4:C5").Select 
    With Selection 
     .Interior.Pattern = xlSolid 
     .Interior.PatternColorIndex = xlAutomatic 
     .Interior.ThemeColor = xlThemeColorDark1 
     .Interior.TintAndShade = -0.149998474074526 
     .Interior.PatternTintAndShade = 0 
     .HorizontalAlignment = xlCenter 
    End With 

    Cells.Select 
    Cells.EntireColumn.AutoFit 
    Columns("B:B").Select 
    Selection.ColumnWidth = 15 
    ActiveWindow.DisplayGridlines = False 
    Range("A1").Select 


    'asks if email should be created 
    Dim answer As Integer 

    answer = MsgBox("Would you like to create email?", vbYesNo + vbQuestion, "Email Option") 

    If answer = vbYes Then EmailFile 
    Else 
    End If 

End Sub 

Sub EmailFile() 

    'Creates email with file attached 
    Dim OutApp As Object 
    Dim OutMail As Object 
    Dim MailBody As String 

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

    MailBody = "<p style='font-family:calibri;font-size:11pt'>" & "Hello,<br><br>" & _ 
       "Attached you will find the weekly report for " & fPO & "." & "<br><br>" & _ 
       "If you have any questions or discrepancies, please let me know!<br><br>Regards," & "</p>" 

    On Error Resume Next 
    With OutMail 
     .Display 
     .to = "" 
     .CC = "" 
     .BCC = "" 
     .Subject = FileName 
     .HTMLbody = MailBody & .HTMLbody 
     .Attachments.Add ActiveWorkbook.FullName 

    End With 
    On Error GoTo 0 

    Set OutMail = Nothing 
    Set OutApp = Nothing 

End Sub 

模塊2 - 爲便於使用

Sub Format() 
' 
' Removes previous raw data and deletes the blank rows so the table doesn't need to be resized upon copy paste of new data 
' 

    On Error Resume Next 
    Rows("4:" & Rows.Count).ClearContents 
    Range("raw[Last Name]").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
    Range("A3:Z3").ClearContents 
    Range("A3").Activate 


End Sub 

Sub Refresh() 

If Range("A3") = "" Then 

MsgBox ("Please paste new data before clicking Refresh.") 

Else 
    ActiveWorkbook.RefreshAll 
End If 

End Sub 
+0

模塊2 ,'Sub Format()'覆蓋模塊1中使用的內置函數('monthfolder = Format(fDate,「mm。 mmmm YYYY「)')。將Sub Format()'重命名爲'Sub Format1()',並根據需要更新代碼 –

+0

哇 - 很高興我花了4個小時試圖研究什麼是錯誤的,謝謝!猜這裏的教訓不是用函數名來命名sub的。 – dougiek

回答

0

在模塊2中的格式的原始數據標籤,Sub Format()覆蓋中使用的內置函數模塊1

(monthfolder = Format(fDate, "mm. mmmm YYYY")) 

重命名Sub Format()Sub Format1()和更新需要的地方

一個簡單的方法來確定衝突的代碼是函數名內單擊,然後按F1鍵啓動幫助模塊 - 它應該回來與「關鍵詞未找到」