Removing extension (.xlsm) when converting to PDF

[jcc88]

Currently I have the code below, but don't know how to add in a code where it removes the .xlsm extension. It saves as FileName.xlsm.pdf right now. Please help!

Sub SaveSelectedSheetsToPDF()Dim str As String, myfolder As String, myfile As String
 
str = "Have you selected your sheets to convert?" & Chr(10)
For Each sht In ActiveWindow.SelectedSheets
str = str & sht.Name & Chr(10)
Next sht
 
answer = MsgBox(str, vbYesNo, "Continue with save?")
If answer = vbNo Then Exit Sub
 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ThisWorkbook.Path & "\" & ThisWorkbook.Name, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=True
 
End Sub

[p45cal]

Your code's a bit of a mess; you've got:
Set wsA = Array("Cover", "Company History", "Quote", "Terms and Conditions")
which shouldn't be Set… but just
wsA = Array("Cover", "Company History", "Quote", "Terms and Conditions")

Then later you have:
strName = wsA.Range("C16").Value _
implying wsA is a worksheet or a range. (That line's also got a line continuation at the end of it.)

We don't know what's in Range("C16") which is important.

Put all that right and we should be able to help.

[jcc88]

I pasted the wrong code. My original code didn't work so I wrote this one. See edited. Thanks

[p45cal]

try:

Sub SaveSelectedSheetsToPDF()
Dim str As String, myfolder As String, myfile As String
 
str = "Have you selected your sheets to convert?" & Chr(10)
For Each sht In ActiveWindow.SelectedSheets
str = str & sht.Name & Chr(10)
Next sht
 
answer = MsgBox(str, vbYesNo, "Continue with save?")
If answer = vbNo Then Exit Sub
 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1), _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=True
 
End Sub

[jcc88]

Awesome, thank you so much!!!! It works amazingly