エクセルのマクロについて教えてください。

Excelのマクロについて教えてください。
PDFファイル名をマクロを実行してセル値をファイル名に変更できますが、
変更するファイルがある場所を指定するダイナログが開きますが、
そのダイナログの先を変更出来る方法を詳しいコードで教えてください。
現状ではダイナログを開くと違うフォルダを指定しておりますので、
マクロが設定しているExcelファイルとファイル名を変更したいファイルは同じフォルダ内にありますので、このフォルダを指定する方法を教えてください。「ThisWorkbook.Path」
マクロ
Sub 交付用名前変更()
Dim TargetFile As String
Dim fPath As String, fName As String
Dim newfName As String
newfName = ThisWorkbook.Sheets("青紙表").Range("CH2").Value & ".pdf"
newfName = NGNarrowToWide(newfName)
TargetFile = Application.GetOpenFilename("PDFファイル ,*.pdf")
If TargetFile = "False" Then Exit Sub
fPath = Left(TargetFile, InStrRev(TargetFile, "\") - 1)
' ファイル名を変更
If TargetFile = fPath & "\" & newfName Then MsgBox "同名ファイルを選択しています": Exit Sub
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
です。
よろしくお願いいたします。

質問者からの補足コメント

• 

  大変困っております。
  このコードを教えて頂けた方、どうぞ、お助けください。
  よろしくお願いいたします。

    補足日時：2023/07/03 10:46

• 

  回答ありがとうございます。
  残念ながら、ネットワーク上のフォルダになっております。
  試験は出来ないとの事ですが、
  コードを教えてはいただけませんでしょうか。
  よろしくお願いします。

  No.2の回答に寄せられた補足コメントです。 補足日時：2023/07/03 11:23

No.4 ベストアンサー 回答者： Qchan1962 回答日時： 2023/07/03 22:11

質問にあるコードを書いたので、横からですみません

その質問には
＞マクロが設定しているExcelファイルと
ファイル名を変更したいファイルは同じフォルダ内にあります

と言う要件がありませんでしたので
簡単なApplication.GetOpenFilename("PDFファイル ,*.pdf")を採用しました

おそらくその要件があったなら、＃１様ご回答の方法になりますね

ご質問者様にはアドバイスやヒントは意味が無いと解釈していますので
ソースコードです

TargetFile = Application.GetOpenFilename("PDFファイル ,*.pdf")
If TargetFile = "False" Then Exit Sub
2行削除
代わりにDialog初期フォルダを設定できるFileDialog(msoFileDialogFilePicker)を使います

With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "PDFファイル(.pdf)", "*.pdf"
.InitialFileName = ThisWorkbook.Path
If .Show Then
TargetFile = .SelectedItems(1)
Else
Exit Sub
End If
End With

No.3 回答者： tatsumaru77 回答日時： 2023/07/03 11:37

>試験は出来ないとの事ですが、

>コードを教えてはいただけませんでしょうか。
newfName = NGNarrowToWide(newfName)の
次へ、以下の3行を追加します。
Dim wsh As Object
Set wsh = CreateObject("WScript.Shell")
wsh.CurrentDirectory = ThisWorkbook.Path

結果的に以下のようになります。
ーーーーーーーーーーーーーーーー
・・・省略・・・
newfName = NGNarrowToWide(newfName)
Dim wsh As Object
Set wsh = CreateObject("WScript.Shell")
wsh.CurrentDirectory = ThisWorkbook.Pat
TargetFile = Application.GetOpenFilename("PDFファイル ,*.pdf")
・・・省略・・・

こちらで、動作確認は行っておりません。
https://vba-labo.rs-techdev.com/archives/1259
の記事を参考にしています。

この回答へのお礼

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

お礼日時：2023/07/03 11:48

No.2 回答者： tatsumaru77 回答日時： 2023/07/03 11:11

>マクロが設定しているExcelファイルとファイル名を変更したいファイルは同じフォルダ内にあります

このマクロのあるファイルを格納しているフォルダは、
ネットワーク上のフォルダですか、
それともローカルなPC上のフォルダでしょうか。
それによって、対応する処理がことなります。
尚、「ネットワーク上のフォルダである」という返信をいただいた場合、
私のPCの環境が「ネットワーク上のフォルダ」を持っていない為、
試験することができません。
「ローカルなPC上のフォルダである」という返信をいただいた場合に限り、
修正したマクロを提供可能です。

No.1 回答者： ほーほけきょッ 回答日時： 2023/07/03 09:22

FileDialog あたりはいかがでしょうか？