none
Save as PDF file in EXCEL RRS feed

  • Question

  • Dear Group

    ive have this kind of VBA CODE in Excel 2010 i can't figure out how to change it to Work out of my solutions so i hope you could help mee

    The code is here...

    My change ill would have is to save file out from Data in 4 cells so the name is like this

    FILENAME "E6 And E8 And R6 And R7".PDF hope somebody could help mee there is Space between where there is a "AND" in normal way it look like this Filename "76632 21-09 Hometeam Guest.PDF"

    Sub SaveAsPDF()
    Dim StrPath As String, StrName As String, Result
    With ActiveDocument
      On Error GoTo Errhandler
      StrPath = GetFolder & "\"
      StrName = Split(.Name, ".")(0)
      While Dir(StrPath & StrName & ".pdf") <> ""
        Result = InputBox("Varning - a file is already there:" & vbCr & _
          Split(.Name, ".")(0) & vbCr & _
          "enter new name or proceed without any action." _
          & vbCr & vbTab & vbTab & vbTab & "Proceed?", "File Exists", StrName)
        If Result = vbCancel Then Exit Sub
        If StrName = Result Then GoTo Overwrite
        StrName = Result
      Wend
    Overwrite:
      .ExportAsFixedFormat OutputFileName:=StrPath & StrName & ".pdf", _
      ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _
      OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
      Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
      CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
      BitmapMissingFonts:=True, UseISO19005_1:=False
    End With
    Errhandler:
    End Sub
     
    Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "chose folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
    End Function

    Private Sub CommandButton1_Click()

     Application.DisplayAlerts = False

    ' Save file name and path into a variable
        template_file = ActiveWorkbook.FullName
     
    ' Default directory would be c:\temp.  Users however will have the ability to change where to save the file if need be.
    ' Notice that i'm only allowing the save as option to be of .txt format.
    ' I'm also attaching the current date to the file name.
        fileSaveName = Application.GetSaveAsFilename( _
         InitialFileName:="C:\temp\filename_" + VBA.Strings.Format(Now, "mmddyyyy") + ".txt", _
         fileFilter:="Text Files (*.txt), *.txt")
        
         If fileSaveName = False Then
             Exit Sub
         End If

    ' Save file as .txt TAB delimited
        ActiveWorkbook.SaveAs Filename:= _
             fileSaveName, FileFormat:=xltxt, _
             CreateBackup:=False

        
         file_name_saved = ActiveWorkbook.FullName
         MsgBox "change with succes: " & vbCr & vbCr & file_name_saved
        
        
    ' Go back to excel format after TAB delimited file has been created and saved
        ActiveWorkbook.SaveAs Filename:= _
             template_file, FileFormat:= _
             xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
             , CreateBackup:=False

          Application.DisplayAlerts = True

    End Sub

    hope for some kind of solutions

    Sunday, September 21, 2014 12:36 PM

Answers

  • Hi Henrik-1,

    According to your description, I think you are want to save the excel file to PDF with the dynamic name which based on the value in the cells.

    Please refer to this code below:

    Private Sub CommandButton1_Click()
    Dim filePath As String
    Dim fileName As String
    Dim fileSaveName As Variant
    Dim cellNames() As String
    Dim item As Variant
     Application.DisplayAlerts = False
    
    
         template_file = ActiveWorkbook.FullName
       
         fileSaveName = Application.GetSaveAsFilename( _
          InitialFileName:="C:\temp\A1 and B1 and C1 and D1.pdf", _
          fileFilter:="Pdf Files (*.pdf), *.pdf")
          
          If fileSaveName = False Then
              Exit Sub
          End If
          
          filePath = Left(fileSaveName, InStrRev(fileSaveName, ".pdf") - 1)
        fileName = Right(filePath, Len(filePath) - InStrRev(filePath, "\"))
        cellNames = Split(fileName, "and")
        Dim str As String
        For Each item In cellNames
            str = str & Range(item) & Chr(32)
        Next
        filePath = Left(filePath, InStrRev(filePath, "\")) & str
        ActiveWorkbook.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            fileName:=filePath, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
     
         
          file_name_saved = ActiveWorkbook.FullName
          MsgBox "change with succes: " & vbCr & vbCr & file_name_saved
           
       
          Application.DisplayAlerts = True
    
    End Sub
    
    
    

    Note: This is the sample, you need to deal with the exception for some specific scenario.

    Best Regards

    Starain Chen


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, September 22, 2014 7:31 AM
    Moderator

All replies

  • Hi Henrik-1,

    According to your description, I think you are want to save the excel file to PDF with the dynamic name which based on the value in the cells.

    Please refer to this code below:

    Private Sub CommandButton1_Click()
    Dim filePath As String
    Dim fileName As String
    Dim fileSaveName As Variant
    Dim cellNames() As String
    Dim item As Variant
     Application.DisplayAlerts = False
    
    
         template_file = ActiveWorkbook.FullName
       
         fileSaveName = Application.GetSaveAsFilename( _
          InitialFileName:="C:\temp\A1 and B1 and C1 and D1.pdf", _
          fileFilter:="Pdf Files (*.pdf), *.pdf")
          
          If fileSaveName = False Then
              Exit Sub
          End If
          
          filePath = Left(fileSaveName, InStrRev(fileSaveName, ".pdf") - 1)
        fileName = Right(filePath, Len(filePath) - InStrRev(filePath, "\"))
        cellNames = Split(fileName, "and")
        Dim str As String
        For Each item In cellNames
            str = str & Range(item) & Chr(32)
        Next
        filePath = Left(filePath, InStrRev(filePath, "\")) & str
        ActiveWorkbook.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            fileName:=filePath, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
     
         
          file_name_saved = ActiveWorkbook.FullName
          MsgBox "change with succes: " & vbCr & vbCr & file_name_saved
           
       
          Application.DisplayAlerts = True
    
    End Sub
    
    
    

    Note: This is the sample, you need to deal with the exception for some specific scenario.

    Best Regards

    Starain Chen


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, September 22, 2014 7:31 AM
    Moderator
  • In the first options it Works Great by choosing folder and save as PDF.....

    but the A1 and B1 and C1 And D1 should bee value from cells in my woorkbook.

    Youre Regards  from mee for giving you time to help my Club and other Dart fans in DENMARK....

    Tuesday, September 23, 2014 8:14 PM
  • Hi Henrik,

    For this code below that in my previous reply is used to get the corresponding value from cells.

    'remove .pdf
    filePath = Left(fileSaveName, InStrRev(fileSaveName, ".pdf") - 1)
    'get file name E.g. A1 and B1 and C1 and D1
        fileName = Right(filePath, Len(filePath) - InStrRev(filePath, "\"))
    'based on and to split the file name, the result will be an array with A1,B1,C1,D1 values
        cellNames = Split(fileName, "and")
        Dim str As String
    'get the correspoding value from cells
        For Each item In cellNames
            str = str & Range(item) & Chr(32)
        Next
        filePath = Left(filePath, InStrRev(filePath, "\")) & str

    Best Regards

    Starain Chen


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Wednesday, September 24, 2014 1:28 AM
    Moderator
  • THANK YOU SO MUCH... its works

    I dont know WHY and HOW you get it too Work because ive hat use RANGE ("Celle").value in some other situation

    A Little future function IF FILE EXITS THEN NOTHING that would be nice and another TEXT in savefile line when SAVE AS Prompt UP but not a must only IF FILE EXIST

    Your Regards from Henrik

    Wednesday, September 24, 2014 4:03 PM
  • Hi Henrik,

    About the Range Object (Excel), please refer to:

    # Range Object (Excel)

    http://msdn.microsoft.com/en-us/library/office/ff838238(v=office.15).aspx

    On the other hand, for the other requirement (future function), I suggest that you’d better create a new thread so that more users can help you to solve it.

    Best Regards

    Starain Chen


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Thursday, September 25, 2014 1:28 AM
    Moderator
  • Sorry to interupt you Again Starain ...ive hat found a mistake in the SAVE AS function you help me with....

    when running it, it save as it should BUT when ive open and see the PDF file i was wonderet because ive hat 32 sheets and want It only to save The Active sheet not all so, therefor my pdf fil was to Large

    Hope you could help me with it

    Your regards From Henrik

    Sunday, September 28, 2014 3:15 PM
  • Hi Henrik,

    For this issue, I suggest that you should create a new thread.

    Best Regards

    Starain Chen


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, September 29, 2014 1:16 AM
    Moderator