Option Explicit

Sub FileSaveAs()
    On Error Resume Next
    Dialogs(wdDialogFileSaveAs).Show
    If Not ActiveDocument.Path = "" Then SaveAsPDF
lbl_Exit:
    Exit Sub
End Sub

Sub FileSave()
    On Error Resume Next
    ActiveDocument.Save
    SaveAsPDF
lbl_Exit:
    Exit Sub
End Sub

Sub SaveAsPDF()
Dim strDocName As String
Dim strPath As String
Dim intPos As Integer
Start:
    'Find position of extension in filename
    strDocName = ActiveDocument.Name
    strPath = ActiveDocument.Path & "\"
    intPos = InStrRev(strDocName, ".")
    If intPos = 0 Then
        ActiveDocument.Save
        GoTo Start
    End If
    strDocName = Left(strDocName, intPos - 1)
    strDocName = strPath & strDocName & ".pdf"

    ActiveDocument.ExportAsFixedFormat OutputFilename:=strDocName, _
                                       ExportFormat:=wdExportFormatPDF, _
                                       OpenAfterExport:=False, _
                                       OptimizeFor:=wdExportOptimizeForPrint, _
                                       Range:=wdExportAllDocument, From:=1, to:=1, _
                                       Item:=wdExportDocumentContent, _
                                       IncludeDocProps:=True, _
                                       KeepIRM:=True, _
                                       CreateBookmarks:=wdExportCreateHeadingBookmarks, _
                                       DocStructureTags:=True, _
                                       BitmapMissingFonts:=True, _
                                       UseISO19005_1:=False
lbl_Exit:
    Exit Sub
End Sub