エクセルのマクロについて教えてください マクロを実行して 作業フォルダの中にある PDFファイル名を

エクセルのマクロについて教えてください
マクロを実行して
作業フォルダの中にある
PDFファイル名をセル値にて
変更できる方法を教えてください 作業フォルダ内にはいくつかのPDFファイルがあります
マクロを実行し
いくつかあるPDFファイルをマウスで一つだけ指定して
作業ブックのシート名青紙（表）
のセル値A1をファイル名に変更できる方法を教えてください
詳しくコードを教えていただける方
よろしくお願いします

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

• 回答ありがとうございます。
  又、ご連絡が遅くなり申し分け有りません。
  ご指示のコードを設定して、マクロを実行しましたが、
  「newfName = NGNarrowToWide(newfName)」の「NGNarrowToWide」の処を示して
  エラーがでてしまい、マクロが実行出来まんでした。
  エラーは「コンパイルエラー」「SUB又はFUNCTIONが定義されていません」とでています。
  申し分け有りません。解決方法を教えてください。
  よろしくお願いします。

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

• エラーが解決出来ていませんので
  何卒よろしくお願いします

    補足日時：2023/07/02 17:38

• 

  いつも、ご親切にありがとうございます。
  上手くファイル名を変更できましたが、
  もう一つ、お願いをしたいのですが
  マクロを実行した時に、ファイル名を変更するファイルがある場所を探す、
  ダイナログが表示されますが、
  このダイナログを
  マクロ設定ファイルがあるフォルダを指定する事は可能でしょうか
  マクロ設定ファイルとファイル名を変更したいファイルは同じフォルダ内にありますので
  何度も申し分け有りません。
  よろしくお願いいたします。

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

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2023/07/02 17:43

Functionはそのまま使っています

Sub Sample()
Dim TargetFile As String
Dim fPath As String, fName As String
Dim newfName As String
newfName = ThisWorkbook.Sheets("青紙（表）").Range("A1").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/02 17:46

No.2 回答者： Qchan1962 回答日時： 2023/07/02 10:13

やり取りになりそうなので　＃１のSample　プロシージャを下記に変更してください　思い付くエラー対策を入れました

Sub Sample()
Dim TargetFile As String
Dim fPath As String, fName As String
Dim newfName As String
newfName = ThisWorkbook.Sheets("青紙（表）").Range("A1").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

Functionはそのまま使っています

No.1 回答者： Qchan1962 回答日時： 2023/07/01 22:00

説明は不要ですかね

禁則文字は全角に変換します

Sub Sample()
Dim TargetFile As String
Dim fPath As String, fName As String
Dim newfName As String
newfName = ThisWorkbook.Sheets("青紙（表）").Range("A1").Value & ".pdf"
newfName = NGNarrowToWide(newfName)
TargetFile = Application.GetOpenFilename("PDFファイル ,*.pdf")
If TargetFile = "False" Then Exit Sub
fPath = Left(TargetFile, InStrRev(TargetFile, "\") - 1)
' ファイル名を変更
Name TargetFile As fPath & "\" & newfName
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