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
模塊2 ,'Sub Format()'覆蓋模塊1中使用的內置函數('monthfolder = Format(fDate,「mm。 mmmm YYYY「)')。將Sub Format()'重命名爲'Sub Format1()',並根據需要更新代碼 –
哇 - 很高興我花了4個小時試圖研究什麼是錯誤的,謝謝!猜這裏的教訓不是用函數名來命名sub的。 – dougiek