Changing Directory back to original file

ardykav

Board Regular
Joined
Oct 18, 2015
Messages
147
Hi

I have a file where I run some code and it allows me to insert a picture into the file on another tab. Once I do this I then run a second piece of code to PDF the file. however I want the PDF to stay in the same folder as the Excel File but what is happening now is its saving it to where I select the picture from. My question is what do i need to do to change the directory back to where the Excel File is? I dont want to actually specify the file path though as I will be saving the Excel document in multiple folders.

2 pieces of code are below

This one inserts the pic
VBA Code:
Option Explicit

Sub GetPics()
Sheets.Add After:=Sheets("Sign Off")
ActiveSheet.Name = "Photos"
ActiveWindow.View = xlPageBreakPreview
    Dim selected_filenames As Variant
    selected_filenames = Application.GetOpenFilename( _
        FileFilter:="Image Files (*.gif;*.jpg;*.png), *.gif;*.jpg;*.png", _
        Title:="Select Pictures To Be Imported", _
        MultiSelect:=True)
    
    If Not IsArray(selected_filenames) Then Exit Sub

    Dim destination_sheet As Worksheet
    Set destination_sheet = Worksheets("Photos")

    Dim current_image As Picture
    Dim i As Long
    For i = LBound(selected_filenames) To UBound(selected_filenames)
        Set current_image = destination_sheet.Pictures.Insert(selected_filenames(i))
        With current_image
            .ShapeRange.LockAspectRatio = msoFalse
            .Left = destination_sheet.Range("A1").Offset(i * 19 - 19).Left
            .Top = destination_sheet.Range("A1").Offset(i * 19 - 19).Top
            .Width = destination_sheet.Range("A1:D18").Offset(i * 19 - 19).Width
            .Height = destination_sheet.Range("A1:D18").Offset(i * 19 - 19).Height
            .Placement = 1
            .PrintObject = True
        End With
    Next i

    destination_sheet.Activate

End Sub

This one saves the file
VBA Code:
Sub ExportAsPDFwithphotos()

Dim saveInFolder As String
'change Folder Path

Application.DisplayAlerts = False
      
    Sheets(Array("Sign Off", "Photos")).Select
 saveInFolder = ThisWorkbook.Path
 
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="ITP-" & Range("C19") & "-" & Format(Now(), "DD-MM-YYYY") & ".pdf", _
       openafterpublish:=False, ignoreprintareas:=False
  Sheets("Sign Off").Select
    Range("a1").Select
    Worksheets("Photos").Delete
    Application.DisplayAlerts = True
    Range("A7").Select
    MsgBox "Your PDF has been created and Photos tab has been cleared"
End Sub

thanks in advance
 

Some videos you may like

Excel Facts

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

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,138
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
 saveinfolder = ThisWorkbook.Path
 
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveinfolder & "\ITP-" & Range("C19") & "-" & Format(Now(), "DD-MM-YYYY") & ".pdf", _
       openafterpublish:=False, ignoreprintareas:=False
 

ardykav

Board Regular
Joined
Oct 18, 2015
Messages
147
Arrgh I tried that but was missing the \ before the ITP, thank you so much all works perfectly now
How about
VBA Code:
saveinfolder = ThisWorkbook.Path

     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveinfolder & "\ITP-" & Range("C19") & "-" & Format(Now(), "DD-MM-YYYY") & ".pdf", _
       openafterpublish:=False, ignoreprintareas:=False
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,138
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,114,035
Messages
5,545,638
Members
410,696
Latest member
JTrehan
Top