Question

以下代码生成一个发票编号序列，每次打开模板时，都会记录发票编号。我最多：

Option Explicit

Private Sub Workbook_Open()

Dim RefNo As Long
Dim Folder As String
Dim SheetNum As Integer
Dim IndexSheet As String
Dim FilePrefix As String
Dim FileSuffix As String

Application.ScreenUpdating = False

Folder = "C:\Users\Desktop\"
FilePrefix = "Invoice#" & " "
FileSuffix = " " & "(DRAFT)"


RefNo = Sheets("Invoice1").Range("NextIndex").Value

'Increment the Reference number
Sheets("Invoice1").Range("NextIndex").Value = RefNo + 1

'Write new Ref No to sheet
Range("ThisIndex").Value = RefNo

'Save this workbook
ThisWorkbook.Save

'Create a new workbook with just 1 sheet
Workbooks.Add (1)

'Copy sheets from template to new workbook

For SheetNum = 1 To ThisWorkbook.Sheets.Count

    ThisWorkbook.Sheets(SheetNum).Copy After:=ActiveWorkbook.Sheets(SheetNum)

Next


'Blank the Next Ref No so it doesn't get saved in the new workbook/sheet
ActiveWorkbook.Worksheets("Invoice1").Range("NextIndex").ClearContents

'Delete default sheet from new workbook
Application.DisplayAlerts = False
ActiveWorkbook.Sheets("Sheet1").Delete
Application.DisplayAlerts = True


'Select Info sheet to make it active
ActiveWorkbook.Sheets("Invoice1").Select

'Save workbook with the new Reference Number name
ActiveWorkbook.SaveAs Folder & FilePrefix & RefNo & FileSuffix & ".xlsx", xlOpenXMLWorkbook

Application.ScreenUpdating = True

'Close the template workbook
ThisWorkbook.Close Savechanges:=False

End Sub

但是，当我添加以下宏时，它会从模板

创建另一个文件

Sub SavePDF()
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:="C:\PDF\Export.pdf", _
        OpenAfterPublish:=False
End Sub

例如，当我使用上面的代码打开模板，并运行分配给将文件保存为PDF的宏时，它会将其保存为PDF，但它会创建另一个模板文件。任何帮助将不胜感激。来自：http://www.myonlinetraininghub.com/macro-enabled-excel-templates

Answer 1

OK @delc我有一个解决方案，但它不是特别优雅。问题是要解除Sub SavePDF＆＃39;来自发票模板文件。此解决方案将此Sub放入新创建的Invoice WorkBook中。所以最大的缺点是新的Invoice工作簿本身就是一个支持宏的工作簿！请注意，我已将.pdf输出调整为仅限第1页，因此按钮和命名范围单元格不会被复制到.pdf文件中。如果需要，您可以在第二段代码中更改此项。你会看到我也重命名了Sub SavePDF＆＃39;。

参考发票模板工作簿：

更换＆＃39; Invoice1＆＃39;上的按钮具有形状的工作表并将其命名为 PDF （编辑文本）。

使用以下代码替换 ThisWorkBook 模块中的当前代码：

Option Explicit

Private Sub Workbook_Open()

Dim RefNo As Long
Dim Folder As String
Dim SheetNum As Integer
Dim IndexSheet As String
Dim FilePrefix As String
Dim FileSuffix As String

Application.ScreenUpdating = False

Folder = "C:\Users\Desktop\"
FilePrefix = "Invoice#" & " "
FileSuffix = " " & "(DRAFT)"


RefNo = Sheets("Invoice1").Range("NextIndex").Value

'Increment the Reference number
Sheets("Invoice1").Range("NextIndex").Value = RefNo + 1

'Write new Ref No to sheet
Range("ThisIndex").Value = RefNo

'Save this workbook
ThisWorkbook.Save

'Create a new workbook with just 1 sheet
Workbooks.Add (1)

'Copy sheets from template to new workbook
    For SheetNum = 1 To ThisWorkbook.Sheets.Count
        ThisWorkbook.Sheets(SheetNum).Copy After:=ActiveWorkbook.Sheets(SheetNum)
    Next

'Blank the Next Ref No so it doesn't get saved in the new workbook/sheet
ActiveWorkbook.Worksheets("Invoice1").Range("NextIndex").ClearContents

'Assign macro to button
ActiveWorkbook.Sheets("Invoice1").Shapes("PDF").Select
Selection.OnAction = ActiveWorkbook.Name & "!Sheet1.PDF_Click"

'Delete default sheet from new workbook
Application.DisplayAlerts = False
ActiveWorkbook.Sheets("Sheet1").Delete
Application.DisplayAlerts = True

'Select Info sheet to make it active
ActiveWorkbook.Sheets("Invoice1").Select

'Save workbook with the new Reference Number name
ActiveWorkbook.SaveAs Filename:=Folder & FilePrefix & RefNo & FileSuffix & ".xlsm", FileFormat:=52
Application.ScreenUpdating = True

'Close the template workbook
ThisWorkbook.Close Savechanges:=False

End Sub

在 Sheet1 模块中输入以下代码：

Sub PDF_Click()

Sheets("Invoice1").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Application.ActiveWorkbook.Path & "\Export.pdf", _
        OpenAfterPublish:=False, From:=1, To:=1

ActiveWorkbook.Save

End Sub

保存并运行它！

其他选项可能是制作“Sub SavePDF”＆＃39;作为UDF并使用键组合操作或在Excel功能区上放置一个按钮来运行它。

Excel工作簿到PDF宏错误

1 个答案: