将发票输入复制到单独的工作表，将发票保存为pdf并重置发票表

Question

我正在寻找将发票数据复制到带有按钮的单独工作表（例如“保存发票”）的VBA代码，将文件保存为.pdf的按钮，最后是带有宏的按钮以重置发票表（“重置”发票”）。我尝试了一些VBA解决方案，但我似乎找不到可行的解决方案。

• 每个新保存的输入应保存在上一个保存输出下方的空行中
• 如果发票中包含数据，则应复制发票中的所有输入/行
• 带有“另存为pdf”的按钮
• 一个“清除工作表”的按钮

码：

Sub InvoiceToRecords()

    LastRecordsRow = Worksheets("Invoice Data").UsedRange.Rows.Count
    'determines the # of rows used

    NewRecordsRow = LastRecordsRow + 1
    'Row for pasting latest invoice will be 1 row below the end of the last invoice

    Sheets("Invoice").Activate

    Range("Invoice").Copy Sheets("Invoice Data").Range("D" & Rows.Count).End(xlUp).Offset(1, 0)

    Range("Customer").Copy Sheets("Invoice Data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Range("Invoice Number").Copy Sheets("Invoice Data").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
    Range("Invoice Date").Copy Sheets("Invoice Data").Range("C" & Rows.Count).End(xlUp).Offset(1, 0)

End Sub

Highlighted code

Error message Syntax error

Answer 1

要复制辅助数据的次数与发票明细行数一样多，您可以按照以下方式执行此操作，只需将代码替换为以下代码：

Sub InvoiceToRecords()
Dim ws As Worksheet: Set ws = Worksheets("Invoice")
Dim wsData As Worksheet: Set wsData = Worksheets("Invoice Data")
'declare and set the worksheets, amend as required
Dim i As Long, dataRows As Long

    dataRows = ws.Range("Invoice").Columns(1).SpecialCells(xlCellTypeConstants, 23).Count
    'count the number of Invoice lines with data (non-empty)
    ws.Range("Invoice").Copy wsData.Range("D" & Rows.Count).End(xlUp).Offset(1, 0)
    'copy invoice lines to Invoice Data
    For i = 1 To dataRows 'loop from 1 to however many lines your named range "Invoice" has
        ws.Range("Customer").Copy wsData.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        ws.Range("Invoice Number").Copy wsData.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
        ws.Range("Invoice Date").Copy wsData.Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
    Next i
End Sub

要将工作表保存为PDF，以下操作，我会使用某种变量来生成PDF文件名，因此您不会一直覆盖同一个文件，可能是公司和发票编号的组合，甚至是时间戳的组合：

Sub foo()
    Dim ws As Worksheet: Set ws = Sheets("Sheet1")
    Filen = "C:\Users\Lorenz\Desktop\NewPdf.pdf"
    'amend filename & path to save above
    ws.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Filen, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
End Sub

更新：

现在把它们放在一起：

Sub InvoiceToRecords()
Dim ws As Worksheet: Set ws = Worksheets("Invoice")
Dim wsData As Worksheet: Set wsData = Worksheets("Invoice Data")
'declare and set the worksheets, amend as required
Dim i As Long, dataRows As Long
'TRANSFER data to Invoice Data
    dataRows = ws.Range("Invoice").Columns(1).SpecialCells(xlCellTypeConstants, 23).Count
    'count the number of Invoice lines with data (non-empty)
    ws.Range("Invoice").Copy wsData.Range("D" & Rows.Count).End(xlUp).Offset(1, 0)
    'copy invoice lines to Invoice Data
    For i = 1 To dataRows 'loop from 1 to however many lines your named range "Invoice" has
        ws.Range("Customer").Copy
        wsData.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        ws.Range("Invoice Number").Copy
        wsData.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        ws.Range("Invoice Date").Copy
        wsData.Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Next i

'SAVE Invoice as PDF
FilenameValue = ws.Range("Customer") & "_Invoice" & ws.Range("Invoice Number")
FilenameValue = Replace(FilenameValue, " ", "") 'remove spaces
FilenameValue = Replace(FilenameValue, ".", "_") 'replace dots with underscore
Filen = "C:\Users\Lorenz\Desktop\" & FilenameValue & ".pdf"
'amend filename & path to save above
ws.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Filen, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

'CLEAR ranges ready for next invoice
ws.Range("Invoice").ClearContents
ws.Range("Customer").ClearContents
ws.Range("Invoice Number").ClearContents
ws.Range("Invoice Date").ClearContents
End Sub