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.