0

所以基本上，我想在我的一个工作表上创建一个超链接，允许我准确地复制它，而不需要几个单元格。

我在 Microsoft 支持网站上发现了这个，它允许工作表完全重复：

Sub Copier1()
    ActiveWorkbook.Sheets("Invoice").Copy _
       after:=ActiveWorkbook.Sheets("Invoice")
End Sub

举个更好的例子，我正在制作一个发票生成器。我可以输入价格和产品，以及计算总计。我正在尝试制作一个简单的按钮，在空白的新工作表中创建新发票，同时让我的发票编号增加 1。

带有透明红色的单元格是不应复制的单元格。虽然，它们包含应该复制的公式。有没有办法在“重置”它并将发票编号加1时复制完整的工作表？所有需要“重置”的单元格都可以在宏中进行硬编码，因为发票布局总是相同的。

在此处输入图像描述

我怎样才能做到这一点？

4

2 回答 2

1

这会复制工作表，然后清除产品信息

Sub createNewInvoice()
'this assumes the top portion of the invoice never changes
Dim startRow As Integer
Dim startCol As Integer
Dim invNumber As Integer
Dim ws As Worksheet
Dim invCol As Integer
Dim invRow As Integer

invRow = 8
invCol = 6 'F column
startRow = 18 '18 is the first line of items
startCol = 2 'B

'get the invoice number
invNumber = CInt(ActiveWorkbook.Sheets("Invoice").Cells(invRow, invCol).Value)
'set the worksheet object
Set ws = ActiveWorkbook.Sheets("Invoice")
'copy after invoice
ws.Copy After:=ws

'update our invoice number
ws.Cells(invRow, invCol).Value = invNumber + 1
'make the worksheet active
ws.Activate
'clear out our cells with the product info
'clear the first line and delete the rest
Do While Trim(ws.Cells(startRow, startCol).Value) <> ""
    If startRow = 18 Then
        ws.Cells(startRow, startCol).EntireRow.ClearContents
    Else
        ws.Cells(startRow, startCol).EntireRow.Delete shift:=Excel.xlShiftUp
        'reset the row
        startRow = startRow - 1
    End If
    'move to the next row
    startRow = startRow + 1
Loop

'release the worksheet object
Set ws = Nothing


End Sub
于 2013-11-19T00:40:08.593 回答
1

我认为在你拥有一个可用的系统之前你还有很长的路要走，但这里有一个例子来说明如何做你所要求的。请注意，其中很多都是非常手动的（所有的Range东西），这使得它很危险——如果你重新排列工作表上的东西，你将不得不相应地修改代码。我强烈推荐 Access 来完成这样的任务，它非常值得学习曲线。另外，我没有在下面这样做，但您可能想要更改新工作表的名称。

Public Sub NewInvoice()
    Dim wksht As Worksheet
    Dim newwksht As Worksheet

    'Copy the Invoice worksheet
    Set wksht = ActiveWorkbook.Sheets("Invoice")
    wksht.Copy after:=wksht

    'The new worksheet is active, get a reference to it
    Set newwksht = ActiveSheet

    With newwksht
        'Clear all the input cells

        'Customer Info
        .Range("C7:C13").Value = ""

        'Company/Date
        .Range("F7").Value = ""
        .Range("F8").Value = .Range("F8").Value + 1 'Increment Invoice Number
        .Range("F9").Value = ""

        'Upper left Product # all the way to the lower right Line Total, however many there might be.
        .Range(.Range("B18"), .Range("B18").End(xlDown).End(xlToRight)).Value = ""
    End With
End Sub
于 2013-11-18T23:34:10.180 回答