Choose the site to save the PDF file

KhallP

Board Regular
Joined
Mar 30, 2021
Messages
157
Office Version
  1. 2016
Platform
  1. Windows
The following code I created is to save the Excel sheet PDF file in a specific folder with a specific filename according to the value of the variables


VBA Code:
Dim FilePath As String

    Select Case MachineName
    
    Case "A4", "A8.1", "A8.2", "A8.3", "A12.1", "A12.2", "A12.3", "A20.1", "A20.2"
         FilePath = Environ("userprofile") & "\Documents\Projeto\" & MachineName & "\"

    Sheets("Miter_Registers").Range("A1:AK29").ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath & "Miter" & " _ " & MachineName & " _ " & Format(Now(), "dd.mm.yyyy") & " _ " & Format(Now(), "hh.mm") & " _ " & ".pdf" _
     , Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
     End Select
End Sub


I would like to know if it is possible to change the code so that the user could save the file in the desired place (such as when downloading an image from the internet) without specifying it beforehand but keeping the file name according to the variable ("MachineName" )
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Trixterz

Board Regular
Joined
Aug 15, 2019
Messages
85
Try things and let me know if it works...
VBA Code:
    Dim Counter As Integer, FindFileType As Integer, SaveAsFileName As String
    
    Select Case MachineName
        Case "A4", "A8.1", "A8.2", "A8.3", "A12.1", "A12.2", "A12.3", "A20.1", "A20.2"
        SaveAsFileName = "Miter" & " _ " & MachineName & " _ " & Format(Now(), "dd.mm.yyyy") & " _ " & Format(Now(), "hh.mm") & " _ "
        
        With Application.FileDialog(msoFileDialogSaveAs)
            FindFileType = 0
            For Counter = 1 To .Filters.Count
                If InStr(VBA.UCase(.Filters(Counter).Description), "PDF") > 0 Then FindFileType = Counter
            Next
    
            .Title = "Save File As PDF"
            .InitialFileName = SaveAsFileName
            .FilterIndex = FindFileType
            
            If .Show Then
                ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=.SelectedItems(1), _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            End If
        End With
    End Select
 

KhallP

Board Regular
Joined
Mar 30, 2021
Messages
157
Office Version
  1. 2016
Platform
  1. Windows
Try things and let me know if it works...
VBA Code:
    Dim Counter As Integer, FindFileType As Integer, SaveAsFileName As String
   
    Select Case MachineName
        Case "A4", "A8.1", "A8.2", "A8.3", "A12.1", "A12.2", "A12.3", "A20.1", "A20.2"
        SaveAsFileName = "Miter" & " _ " & MachineName & " _ " & Format(Now(), "dd.mm.yyyy") & " _ " & Format(Now(), "hh.mm") & " _ "
       
        With Application.FileDialog(msoFileDialogSaveAs)
            FindFileType = 0
            For Counter = 1 To .Filters.Count
                If InStr(VBA.UCase(.Filters(Counter).Description), "PDF") > 0 Then FindFileType = Counter
            Next
   
            .Title = "Save File As PDF"
            .InitialFileName = SaveAsFileName
            .FilterIndex = FindFileType
           
            If .Show Then
                ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=.SelectedItems(1), _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            End If
        End With
    End Select
Your code is close but I just need to export to PDF the sheet ("Miter") with range ("A1:AK29"), could you help me?
 

Trixterz

Board Regular
Joined
Aug 15, 2019
Messages
85
Oops my bad... forgot to include the last part..
VBA Code:
    Dim Counter As Integer, FindFileType As Integer, SaveAsFileName As String
    
    Select Case MachineName
        Case "A4", "A8.1", "A8.2", "A8.3", "A12.1", "A12.2", "A12.3", "A20.1", "A20.2"
        SaveAsFileName = "Miter" & " _ " & MachineName & " _ " & Format(Now(), "dd.mm.yyyy") & " _ " & Format(Now(), "hh.mm") & " _ "
        
        With Application.FileDialog(msoFileDialogSaveAs)
            FindFileType = 0
            For Counter = 1 To .Filters.Count
                If InStr(VBA.UCase(.Filters(Counter).Description), "PDF") > 0 Then FindFileType = Counter
            Next
    
            .Title = "Save File As PDF"
            .InitialFileName = SaveAsFileName
            .FilterIndex = FindFileType
            
            If .Show Then
                ActiveWorkbook.Sheets("Miter_Registers").Range("A1:AK29").ExportAsFixedFormat Type:=xlTypePDF, Filename:=.SelectedItems(1), _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            End If
        End With
    End Select
 

Forum statistics

Threads
1,136,302
Messages
5,674,965
Members
419,537
Latest member
ucatchy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top