Excelのマクロについて教えてください。

下記のマクロは以前教えて頂いたマクロで、このマクロを実行すると
ダイアログが開き指定したPDFファイルを指定セル値にてファイル名が変更され、
マクロ設定ブックと同じフォルダ内に保存されます。
ファイル名を変更したファイルの保存先をマクロ設定ブックと同じフォルダ内では無く
変更したいファイル名を変更したい「PDFファイル」があるフォルダ内にそのまま指定セル値でのファイル名に変更して保存できる方法を教えてください。
現状のマクロ
Sub 行政回答修正あり()
Dim TargetFile As String
Dim fPath As String, fname As String
Dim newfName As String

newfName = ThisWorkbook.Sheets("Webコメント").Range("V1").Value & ".pdf"
newfName = NGNarrowToWide(newfName)

''メッセージを表示し、実施確認する。
If MsgBox(newfName & vbCrLf & vbCrLf & "行政回答（修正あり）を作成しますか。", vbExclamation + vbOKCancel) <> vbOK Then Exit Sub

' ファイルのパスを指定
fPath = ThisWorkbook.Path

' ダイアログを表示してファイルを選択
TargetFile = Application.GetOpenFilename("PDFファイル ,*.pdf", , "ファイルを選択", , False)

If TargetFile = "False" Then Exit Sub

' ファイル名を変更
If TargetFile = fPath & "\" & newfName Then
MsgBox "同名ファイルを選択しています"
Exit Sub
End If

If Not Dir(fPath & "\" & newfName) <> "" Then
Name TargetFile As fPath & "\" & newfName
Else
Dim rc As Integer
rc = MsgBox("既に存在する名前です" & vbCrLf & "はいを押すと既存ファイルは削除され" & vbCrLf & "リネームファイルに置き換えられます", 52, "置き換え確認")
If rc = vbYes Then
Application.DisplayAlerts = False
Kill fPath & "\" & newfName
Name TargetFile As fPath & "\" & newfName
Application.DisplayAlerts = True
Else
MsgBox "処理を中止しました"
End If
End If
End Sub
Public Function NGNarrowToWide(ByVal stg As String) As String
stg = Replace(Replace(Replace(Replace(stg, "\", "￥"), "/", "／"), ":", "："), "*", "＊")
stg = Replace(Replace(Replace(Replace(stg, "?", "？"), "<", "＜"), ">", "＞"), "|", "｜")
stg = Replace(stg, """", Chr(&H8168))
NGNarrowToWide = stg
End Function

No.2 ベストアンサー 回答者： tatsumaru77 回答日時： 2024/10/23 11:07

No1の方のアドバイスに従い、修正してみました。

Public Function NGNarrowToWideは修正していませんので、
Sub 行政回答修正あり()のみを掲載します。

Sub 行政回答修正あり()
Dim TargetFile As String
Dim fPath As String, fname As String
Dim newfName As String
Dim p0 As Long
newfName = ThisWorkbook.Sheets("Webコメント").Range("V1").Value & ".pdf"
newfName = NGNarrowToWide(newfName)

''メッセージを表示し、実施確認する。
If MsgBox(newfName & vbCrLf & vbCrLf & "行政回答（修正あり）を作成しますか。", vbExclamation + vbOKCancel) <> vbOK Then Exit Sub

' ダイアログを表示してファイルを選択
TargetFile = Application.GetOpenFilename("PDFファイル ,*.pdf", , "ファイルを選択", , False)

If TargetFile = "False" Then Exit Sub

' ファイルのパスを取得
p0 = InStrRev(TargetFile, "\")
fPath = Left(TargetFile, p0 - 1)

' ファイル名を変更
If TargetFile = fPath & "\" & newfName Then
MsgBox "同名ファイルを選択しています"
Exit Sub
End If

If Not Dir(fPath & "\" & newfName) <> "" Then
Name TargetFile As fPath & "\" & newfName
Else
Dim rc As Integer
rc = MsgBox("既に存在する名前です" & vbCrLf & "はいを押すと既存ファイルは削除され" & vbCrLf & "リネームファイルに置き換えられます", 52, "置き換え確認")
If rc = vbYes Then
Application.DisplayAlerts = False
Kill fPath & "\" & newfName
Name TargetFile As fPath & "\" & newfName
Application.DisplayAlerts = True
Else
MsgBox "処理を中止しました"
End If
End If
End Sub

この回答へのお礼

回答ありがとうございます。
親切にコードも教えて頂きまして、ありがとうございます。
早速変更させていただきます。

お礼日時：2024/10/23 11:13

No.1 回答者： いんちょ 回答日時： 2024/10/22 13:14

Dir(TargetFile)でファイル名が得られます。

TargetFile中のファイル名部分をRange("V1").Valueで置き換えたものをnewfNameとすればOKです。

この回答へのお礼

回答ありがとうございます。
早速試してみます。

お礼日時：2024/10/22 13:15