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

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

前提是您没有无效的字符，例如\\ /：*？ “ <> |在文件名单元格值中，并假设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