简体   繁体   中英

Save Excel file with a cell content name

I am in the process of developing a Macro which will save the Excel file as a PDF and another excel file. Its should also rename these files using content from one of the cell in the file.

I have the code as below.

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

Right now it is saving all the files by the name 123456.xlsx and 123456.pdf

Provided you do not have any invalid characters like \\ / : * ? " < > | in file name cell value & assuming N column has content for file name, you can do it as follows

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
....
...

`

Here are some examples of things you can do.

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

Using a subroutine for saving the PDF

Sub SaveAsPDF(fileNPath As String)

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

You can have your Excel File name broken into parts with underscores also and replace just a section of the name. For example: YearlySales_2014.xlsm Then replace the YEAR value with a cell value using Split down to components and rebuild the name programmatically:

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM