We help IT Professionals succeed at work.

Updating an Excel Macro to include PDF

wrt1mea
wrt1mea asked
on
Medium Priority
81 Views
Last Modified: 2020-02-01
I am wanting to update the following macro to include saving it as a PDF before clearing the contents

Ideally, I would like the pdf to not open on save and save to the following file path:

C:\Users\admin\Desktop\temp\INVOICES\PDF

Sub SvMe()
     'Saves filename as value of A1 plus the current date
     
    Dim newFile As String, fName As String
     ' Don't use "/" in date, invalid syntax
    fName = Range("D12").Value
     'Change the date format to whatever you'd like, but make sure it's in quotes
    newFile = fName & " " & Format$(Date, "mm-dd-yyyy")
     ' Change directory to suit your PC, including USER NAME
    ChDir _
    "C:\Users\admin\Desktop\temp\INVOICES"
    ActiveWorkbook.SaveAs filename:=newFile
    ClearUnlockedCells
End Sub

Sub ClearUnlockedCells()
Dim cel As Range, rg As Range
Application.ScreenUpdating = False
With Worksheets("INVOICE")
    Set rg = .Range("B1:J50")
    For Each cel In rg.Cells
        If (cel.Locked = False) And (cel.Value <> "") Then cel.MergeArea.ClearContents
    Next
End With
End Sub

Open in new window

Comment
Watch Question

Test your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016
Commented:

Give this a try, I think this should do what you wanted...


 Sub SvMe()
    'Saves filename as value of A1 plus the current date
     
    Dim newFile As String, fName As String
    ' Don't use "/" in date, invalid syntax
    fName = Range("D12").Value
    'Change the date format to whatever you'd like, but make sure it's in quotes
    newFile = fName & " " & Format$(Date, "mm-dd-yyyy")
    ' Change directory to suit your PC, including USER NAME
    ChDir "C:\Users\admin\Desktop\temp\INVOICES"
    ActiveWorkbook.SaveAs filename:=newFile

    ' Also save as a PDF file    
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\admin\Desktop\temp\INVOICES\PDF\" & newFile & ".pdf"

    ClearUnlockedCells

End Sub

Sub ClearUnlockedCells()
    Dim cel As Range, rg As Range
    Application.ScreenUpdating = False
    With Worksheets("INVOICE")
        Set rg = .Range("B1:J50")
        For Each cel In rg.Cells
            If (cel.Locked = False) And (cel.Value <> "") Then cel.MergeArea.ClearContents
        Next
    End With
End Sub

Author

Commented:
Bill,

Thanks....I will try on the sheet this evening when I get home from the office. Keep you posted.

Author

Commented:
Thanks Bill!

Works perfectly!!!!
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Welcome.


»bp