Question

我正在开发一个宏，它将Excel文件另存为PDF和另一个excel文件。它还应该使用文件中某个单元格的内容重命名这些文件。

我的代码如下。

Sub Save_As_Excel_and_PDF()
'
' Save_As_Excel_and_PDF Macro
' This Macro will save the PO in Excel and PDF (New Files) in the PO folder on Desktop
'

'
    Sheets("Sheet1").Select
    Sheets("Sheet1").Copy
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("N:T").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("L4:M4").Select
    Cells.Find(What:="regd office", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Range(Selection, Cells(1)).Select
    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

'At this point I want it to Copy a content from the excel file and Name the PDF file by pasting this content in the file name section'

        "C:\Users\Nakul\Desktop\PO\123456.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
    ActiveWorkbook.SaveAs Filename:="C:\Users\Nakul\Desktop\PO\123456.xlsx", _

'I also want to save an excel file with that name.

        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub

现在它以123456.xlsx和123456.pdf名称保存所有文件

Answer 1

如果您没有像\ /：*这样的无效字符？＆＃34; ＆LT; ＆GT; |在文件名单元格值＆amp; 假设N列包含文件名的内容，您可以按照以下步骤进行操作

Dim rownum As Long
Dim Filename As String
...
...
Range("L4:M4").Select
Excel.Cells.Find(What:="regd office", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Select

rownum = Excel.ActiveCell.Row    
Filename = Excel.Range("N" & rownum).Value
....
...

`

Answer 2

以下是您可以执行的一些示例。

Sub CreateFileName()

Dim oldName As String
Dim oldParts() As String
Dim oldBase As String
Dim path As String
Dim fileName As String
Dim newName As String
Dim fileExt As String
Dim fileNPath As String
Dim rowNum As Long

path = ActiveWorkbook.path                      'Get the active path  --THIS IS HANDY--
oldName = ActiveWorkbook.Name                   'Get the name of the Active Workbook

oldParts = Split(oldName, ".")                  'example.xlsm   Split into parts using . as the separator
oldBase = oldParts(0)                           'example     name (Index 0)
fileExt = oldParts(1)                           '.xlsm       Extension (Index 1)

newName = Sheets("Sheet1").Cells(rowNum, 14).Value     'Set the newName based on cell value using Cells Reference
newName = Sheets("Sheet1").Range("N" & rowNum).Value    'Set the newName based on cell value using Range Reference

fileName = newName
fileNpath = path & "\" & fileName

Call SaveAsPDF(fileNPath)                       'Save the PDF First Without the extension build in

fileNPath = path & "\" & newName & "." &  fileExt   
ActiveWorkbook.SaveAs fileName:=fileNpath       ' Save the File wITH the extension

End Sub

使用子程序保存PDF

Sub SaveAsPDF(fileNPath As String)

    ActiveSheet.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                fileName:=fileNPath & ".pdf", _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
End Sub

您可以将Excel文件名拆分为带下划线的部分，并仅替换名称的一部分。例如：YearlySales_2014.xlsm然后使用拆分为组件将单元格值替换为YEAR值，并以编程方式重建名称：

oldName = "YearlySales_2014.xlsm"
oldParts = Split(oldName, ".")         '(0) = YearlySales_2014    (1) = xlsm  
fileExt = oldParts(1)                  
oldBase = Split(oldParts(0), "_")      'takes YearlySales_2014 and Splits to (0) = YearlySales    (1) = 2014

tYear = Sheets("Sheet1").Range("A1")  'Say a year value is stored here. 2015
newName = oldBase(0) & "_" & tYear          'YearlySales_2015

fileNPath = path & "\" & newName & "." & fileExt   'C:\Desktop\YearlySales_2015.xlsm

使用单元格内容名称保存Excel文件

2 个答案: