根据模板和数据工作表生成多个发票

时间:2013-07-05 10:24:17

标签: vba excel-vba for-loop excel

我正在尝试根据模板和Excel数据生成多张发票并保存。以下代码给我一个1004错误 - 应用程序定义或对象定义错误。你能帮忙吗?我是vba的新手。

Sub AddNew()
    Dim str1, str2, str3 As String
    Dim numrows As Integer
    Dim i As Integer

    numrows = ActiveWorkbook.Sheets("Rawdata").Range("A" & Rows.Count).End(xlUp).Row - 2
    MsgBox numrows
    i = 3

    While numrows > 0
        str1 = ActiveWorkbook.Sheets("Rawdata").Cells(i, 16).Value
        MsgBox (str1)
        str2 = ActiveWorkbook.Sheets("Rawdata").Cells(i, 1).Value

        'cannot save filename with backslash
        str3 = Replace(ActiveWorkbook.Sheets("Rawdata").Cells(i, 2).Value, "/", "-")

        Set NewBook = Workbooks.Add
        With NewBook
            .Title = "All Invoice"
            .Subject = "Invoice"
            .SaveAs Filename:="D:\Nandini\Invoice generation automation\" & str1 & " " & Format(str2, "mmm") & "-" & Format(str2, "YYYY") & " " & str3 & ".xlsx"
            .Close SaveChanges:=True
        End With

        ActiveWorkbook.Sheets("Invoice").Select
        Cells.Select
        Selection.Copy

        Workbooks.Open ("D:\Nandini\Invoice generation automation\" & str1 & " " &     Format(str2, 
"mmm") & "-" & Format(str2, "YYYY") & " " & str3 & ".xlsx")

        activeworksheet.Paste

        numrows = numrows - 1

        i = i + 1
    Wend
End Sub

1 个答案:

答案 0 :(得分:0)

尝试以下代码:

Sub AddNew()
    Dim str1, str2, str3 As String
    Dim numrows As Integer
    Dim i As Integer
    Dim NewBook As Workbook, oWkb As Workbook

    With ThisWorkbook.Sheets("Rawdata")
       numrows = .Range("A" & .Rows.Count).End(xlUp).Row - 2
       i = 3

        While numrows > 0
            str1 = .Cells(i, 16).Value
            str2 = .Cells(i, 1).Value

            'cannot save filename with backslash
            str3 = Replace(.Cells(i, 2).Value, "/", "-")

            Set NewBook = Workbooks.Add
            With NewBook
                .Title = "All Invoice"
                .Subject = "Invoice"
                .SaveAs Filename:="D:\Nandini\Invoice generation automation\" & str1 & " " & Format(str2, "mmm") & "-" & Format(str2, "YYYY") & " " & str3 & ".xlsx"
                .Close SaveChanges:=True
            End With

            ThisWorkbook.Sheets("Invoice").Cells.Copy
            Set oWkb = Workbooks.Open("D:\Nandini\Invoice generation automation\" & str1 & " " & Format(str2, "mmm") & "-" & Format(str2, "YYYY") & " " & str3 & ".xlsx")

            oWkb.ActiveSheet.Range("A1").PasteSpecial
            numrows = numrows - 1

            i = i + 1
        Wend

     End With
End Sub