Question

我发现这段代码效果很好，但我需要将1张工作簿保存为pdf。将文件格式更改为xltypepdf时，我一直收到错误消息。有人可以帮忙。

Sub DateFolderSave() 
Application.DisplayAlerts = False 
' Check for year folder and create if needed If 
Len(Dir("C:\Users\Christine\Desktop\Learner Lists LC\" & Year(Date), 
vbDirectory)) = 0 Then 
MkDir "C:\Users\Christine\Desktop\Learner Lists LC\" & Year(Date) 
End If 
' Check for month folder and create if needed If 
Len(Dir("C:\Users\Christine\Desktop\Learner Lists LC\" & Year(Date) & "\" & 
MonthName(Month(Date), False), vbDirectory)) = 0 Then MkDir 
"C:\Users\Christine\Desktop\Learner Lists LC\" & Year(Date) & "\" & 
MonthName(Month(Date), False)
 End If 
' Check for date folder and create if needed If 
Len(Dir("C:\Users\Christine\Desktop\Learner Lists LC\" & Year(Date) & "\" & 
MonthName(Month(Date), False) & "\" & Format(Date, "dd.mm.yy"), 
vbDirectory)) = 0 Then 
MkDir "C:\Users\Christine\Desktop\Learner Lists LC\" & Year(Date) & "\" & 
MonthName(Month(Date), False) & "\" & Format(Date, "dd.mm.yy") 
End If
 ' Save File 
ActiveWorkbook.SaveAs Filename:= _ "C:\Users\Christine\Desktop\Learner Lists 
LC\" & Year(Date) & "\" & MonthName(Month(Date), False) & "\" & Format(Date, 
"dd.mm.yy") & ".xlsm", _ FileFormat:=xlOpenXMLWorkbookMacroEnabled, 
CreateBackup:=False 
Application.DisplayAlerts = True 
' Popup Message MsgBox "File Saved As:" &   vbNewLine & 
C:\Users\Desktop\Learner Lists LC\" & Year(Date) & _ "\" & 
MonthName(Month(Date), False) & "\" & Format(Date, "mm.dd.yy") & ".xlsm"
End Sub

Answer 1

我做的第一件事（在弄清楚你的代码开始和结束的地方之后）是Search＆amp;替换，使用1个变量和1个常量（而不是相同的文件夹名称重复8次）。

我的侦探技巧告诉我你对VBA来说是全新的：使用常数和变量是第一课，因为它们是＆＃34;所有编码和基础的基础。发展＆＃34; 。

但不用担心，每个人都必须从某个地方开始。我重写了你的子程序：

Option Explicit

Sub ExportSheetToPDF()
'exports ActiveWorksheet to dated PDF

    'Set openPDFwhenDone to TRUE to auto-open the PDF when finished
    Const openPDFwhenDone = True

    'Set constant basePath to the file save path
    Const basePath = "C:\Users\Christine\Desktop\Learner Lists LC\"

    'Declare variable pdfPath which for the complete path & filename
    Dim pdfPath As String

    'get the name of the "year" folder
    pdfPath = basePath & Year(Date)

    'if the "year" folder doesn't exist then create it
    If Dir(pdfPath, vbDirectory) = "" Then MkDir pdfPath

    'get the name of the "month" folder
    pdfPath = pdfPath & "\" & Format(Month(Date), "00")

    'if the "month" folder doesn't exist then create it
    If Dir(pdfPath, vbDirectory) = "" Then MkDir pdfPath

    'get the complete pdf filename
    pdfPath = pdfPath & "\" & Format(Date, "yyyy-mm-dd") & ".pdf"

    'export active worksheet as PDF to pdfPath
    ActiveSheet.ExportAsFixedFormat xlTypePDF, pdfPath,,,,,, openPDFwhenDone

    'make sure the pdf file was created
    If Dir(pdfPath) = "" Then
        'file not found
        MsgBox "Something went wrong. (PDF wasn't created.)"
    Else
        'Success!  Show success message (unless PDF was set to auto-open)
        If Not openPDFwhenDoneThen MsgBox "File Saved As:" & vbLf & pdfPath
    End If

End Sub

在我开始接受之前，我假设了＃34;所有代码＆＃34;除了搞清楚文件名和导出外，还做了很多！请注意代码的哪些部分已替换为变量pdfPath。尺寸可能无关紧要，但效率和易读性确实如此！

我在上面的代码中添加了很多注释，因此它更容易理解，但作为一个例子，下面的代码几乎是相同的，只是进一步压缩。实际上创建PDF文件只是一行代码。

Sub ExportSheetToPDF_smaller()
    Const basePath = "C:\Users\Christine\Desktop\Learner Lists LC\"
    If Dir(basePath & Year(Date), vbDirectory) = "" Then MkDir basePath & Year(Date)
    If Dir(basePath & Format(Date, "yyyy\\mm"), vbDirectory) = "" Then MkDir basePath & Format(Date, "yyyy\\mm")
    ActiveSheet.ExportAsFixedFormat xlTypePDF, Format(Date, "yyyy\\mm\\yyyy-mm-dd.p\df"), , , , , , True
    MsgBox "File Saved As:" & vbLf & Dir(basePath & Format(Date, "yyyy\\mm\\yyyy-mm-dd.p\df"))
End Sub

因此，作为免费代码的回报，您可以完成作业。严重。请花点时间浏览下面的链接，将这些命令与上面的代码示例进行比较，因为它们涵盖了所使用的每个命令，并且是一个很好的起点。还有很多其他资源（甚至YouTube是隐藏的教程库）......

VBA家庭作业：

如果您的PDF导出有效，请与我们联系。

祝你好运！

保存为PDF，在年和月文件夹下

1 个答案: