Sub 交付用名前変更A4()
    Dim TargetFile As String
    Dim fpath As String, fname As String
    Dim oldfName1 As String
    Dim oldfName2 As String
    Dim newfName1 As String
    Dim newfName2 As String
    Dim oldpath1 As String
    Dim oldpath2 As String
    Dim newpath1 As String
    Dim newpath2 As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim rg As Range
    Dim names As Variant
    Dim name As Variant
    Dim key As String
    Dim dicT As Object
    Set dicT = CreateObject("Scripting.Dictionary")
    Set ws = ThisWorkbook.Worksheets("昇降機質疑")
    '空白セルチェック
    Set rng = ws.Range("A4,v3,A3,V9")
    For Each rg In rng
        If rg.Value = "" Then
            MsgBox ("該当ファイルがありません")
            ws.Activate
            rg.Select
            Exit Sub
        End If
    Next
    'ファイ名変更1
    oldfName1 = ws.Range("A4").Value
    oldfName1 = NGNarrowToWide(oldfName1)
    newfName1 = ws.Range("V3").Value & ".pdf"
    newfName1 = NGNarrowToWide(newfName1)
    'ファイ名変更2
    oldfName2 = ws.Range("A3").Value
    oldfName2 = NGNarrowToWide(oldfName2)
    newfName2 = ws.Range("V9").Value & ".pdf"
    newfName2 = NGNarrowToWide(newfName2)
    names = Array(oldfName1, newfName1, oldfName2, newfName2)
    'ファイル名重複チェック
    For Each name In names
        key = LCase(name)
        If dicT.exists(key) = True Then
            MsgBox ("ファイル名が重複しています。<" & name & ">")
            Exit Sub
        End If
        dicT(key) = True
    Next
    'ファイル名の整合性チェック
    If check_files(oldfName1, newfName1, oldpath1, newpath1) = False Then Exit Sub
    If check_files(oldfName2, newfName2, oldpath2, newpath2) = False Then Exit Sub
    ''メッセージを表示し、実施確認する。
    If MsgBox("A4・A3の交付用を作成しますか？", vbExclamation + vbOKCancel) <> vbOK Then Exit Sub
    'ファイル名変更
    Call change_name(oldpath1, newpath1)
    Call change_name(oldpath2, newpath2)
    MsgBox ("ファイル名変更完了")
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
'ファイル名チェック
Private Function check_files(ByVal oldfname As String, ByVal newfname As String, ByRef oldpath As String, ByRef newpath As String) As Boolean
    check_files = False
    If LCase(Right(oldfname, 4)) <> ".pdf" Then
        MsgBox (oldfname & "の拡張子が不正です")
        Exit Function
    End If
    oldpath = ThisWorkbook.path & "\" & oldfname
    If Dir(oldpath) = "" Then
        MsgBox (oldfname & "が存在しません")
        Exit Function
    End If
    newpath = ThisWorkbook.path & "\" & newfname
    If Dir(newpath) <> "" Then
        Dim rc As Integer
        rc = MsgBox(newfname & "は既に存在する名前です" & vbCrLf & "はいを押すと既存ファイルは削除され" & vbCrLf & "リネームファイルに置き換えられます", vbYesNo, "置き換え確認")
        If rc <> vbYes Then
            MsgBox "処理を中止しました"
            Exit Function
        End If
    End If
    check_files = True
End Function
'ファイり名変更
Private Sub change_name(ByVal oldpath As String, ByVal newpath As String)
    If Dir(newpath) <> "" Then
        Application.DisplayAlerts = False
        Kill newpath
        Application.DisplayAlerts = True
    End If
    Name oldpath As newpath
End Sub
 

U3ViIOS6pOS7mOeUqOWQjeWJjeWkieabtEE0KCkKICAgIERpbSBUYXJnZXRGaWxlIEFzIFN0cmluZwogICAgRGltIGZwYXRoIEFzIFN0cmluZywgZm5hbWUgQXMgU3RyaW5nCiAgICBEaW0gb2xkZk5hbWUxIEFzIFN0cmluZwogICAgRGltIG9sZGZOYW1lMiBBcyBTdHJpbmcKICAgIERpbSBuZXdmTmFtZTEgQXMgU3RyaW5nCiAgICBEaW0gbmV3Zk5hbWUyIEFzIFN0cmluZwogICAgRGltIG9sZHBhdGgxIEFzIFN0cmluZwogICAgRGltIG9sZHBhdGgyIEFzIFN0cmluZwogICAgRGltIG5ld3BhdGgxIEFzIFN0cmluZwogICAgRGltIG5ld3BhdGgyIEFzIFN0cmluZwogICAgRGltIHdzIEFzIFdvcmtzaGVldAogICAgRGltIHJuZyBBcyBSYW5nZQogICAgRGltIHJnIEFzIFJhbmdlCiAgICBEaW0gbmFtZXMgQXMgVmFyaWFudAogICAgRGltIG5hbWUgQXMgVmFyaWFudAogICAgRGltIGtleSBBcyBTdHJpbmcKICAgIERpbSBkaWNUIEFzIE9iamVjdAogICAgU2V0IGRpY1QgPSBDcmVhdGVPYmplY3QoIlNjcmlwdGluZy5EaWN0aW9uYXJ5IikKICAgIFNldCB3cyA9IFRoaXNXb3JrYm9vay5Xb3Jrc2hlZXRzKCLmmIfpmY3mqZ/os6rnlpEiKQogICAgJ+epuueZveOCu+ODq+ODgeOCp+ODg+OCrwogICAgU2V0IHJuZyA9IHdzLlJhbmdlKCJBNCx2MyxBMyxWOSIpCiAgICBGb3IgRWFjaCByZyBJbiBybmcKICAgICAgICBJZiByZy5WYWx1ZSA9ICIiIFRoZW4KICAgICAgICAgICAgTXNnQm94ICgi6Kmy5b2T44OV44Kh44Kk44Or44GM44GC44KK44G+44Gb44KTIikKICAgICAgICAgICAgd3MuQWN0aXZhdGUKICAgICAgICAgICAgcmcuU2VsZWN0CiAgICAgICAgICAgIEV4aXQgU3ViCiAgICAgICAgRW5kIElmCiAgICBOZXh0CiAgICAn44OV44Kh44Kk5ZCN5aSJ5pu0MQogICAgb2xkZk5hbWUxID0gd3MuUmFuZ2UoIkE0IikuVmFsdWUKICAgIG9sZGZOYW1lMSA9IE5HTmFycm93VG9XaWRlKG9sZGZOYW1lMSkKICAgIG5ld2ZOYW1lMSA9IHdzLlJhbmdlKCJWMyIpLlZhbHVlICYgIi5wZGYiCiAgICBuZXdmTmFtZTEgPSBOR05hcnJvd1RvV2lkZShuZXdmTmFtZTEpCiAgICAn44OV44Kh44Kk5ZCN5aSJ5pu0MgogICAgb2xkZk5hbWUyID0gd3MuUmFuZ2UoIkEzIikuVmFsdWUKICAgIG9sZGZOYW1lMiA9IE5HTmFycm93VG9XaWRlKG9sZGZOYW1lMikKICAgIG5ld2ZOYW1lMiA9IHdzLlJhbmdlKCJWOSIpLlZhbHVlICYgIi5wZGYiCiAgICBuZXdmTmFtZTIgPSBOR05hcnJvd1RvV2lkZShuZXdmTmFtZTIpCiAgICBuYW1lcyA9IEFycmF5KG9sZGZOYW1lMSwgbmV3Zk5hbWUxLCBvbGRmTmFtZTIsIG5ld2ZOYW1lMikKICAgICfjg5XjgqHjgqTjg6vlkI3ph43opIfjg4Hjgqfjg4Pjgq8KICAgIEZvciBFYWNoIG5hbWUgSW4gbmFtZXMKICAgICAgICBrZXkgPSBMQ2FzZShuYW1lKQogICAgICAgIElmIGRpY1QuZXhpc3RzKGtleSkgPSBUcnVlIFRoZW4KICAgICAgICAgICAgTXNnQm94ICgi44OV44Kh44Kk44Or5ZCN44GM6YeN6KSH44GX44Gm44GE44G+44GZ44CCPCIgJiBuYW1lICYgIj4iKQogICAgICAgICAgICBFeGl0IFN1YgogICAgICAgIEVuZCBJZgogICAgICAgIGRpY1Qoa2V5KSA9IFRydWUKICAgIE5leHQKICAgICfjg5XjgqHjgqTjg6vlkI3jga7mlbTlkIjmgKfjg4Hjgqfjg4Pjgq8KICAgIElmIGNoZWNrX2ZpbGVzKG9sZGZOYW1lMSwgbmV3Zk5hbWUxLCBvbGRwYXRoMSwgbmV3cGF0aDEpID0gRmFsc2UgVGhlbiBFeGl0IFN1YgogICAgSWYgY2hlY2tfZmlsZXMob2xkZk5hbWUyLCBuZXdmTmFtZTIsIG9sZHBhdGgyLCBuZXdwYXRoMikgPSBGYWxzZSBUaGVuIEV4aXQgU3ViCiAgICAnJ+ODoeODg+OCu+ODvOOCuOOCkuihqOekuuOBl+OAgeWun+aWveeiuuiqjeOBmeOCi+OAggogICAgSWYgTXNnQm94KCJBNOODu0Ez44Gu5Lqk5LuY55So44KS5L2c5oiQ44GX44G+44GZ44GL77yfIiwgdmJFeGNsYW1hdGlvbiArIHZiT0tDYW5jZWwpIDw+IHZiT0sgVGhlbiBFeGl0IFN1YgogICAgJ+ODleOCoeOCpOODq+WQjeWkieabtAogICAgQ2FsbCBjaGFuZ2VfbmFtZShvbGRwYXRoMSwgbmV3cGF0aDEpCiAgICBDYWxsIGNoYW5nZV9uYW1lKG9sZHBhdGgyLCBuZXdwYXRoMikKICAgIE1zZ0JveCAoIuODleOCoeOCpOODq+WQjeWkieabtOWujOS6hiIpCkVuZCBTdWIKUHVibGljIEZ1bmN0aW9uIE5HTmFycm93VG9XaWRlKEJ5VmFsIHN0ZyBBcyBTdHJpbmcpIEFzIFN0cmluZwogICAgc3RnID0gUmVwbGFjZShSZXBsYWNlKFJlcGxhY2UoUmVwbGFjZShzdGcsICJcIiwgIu+/pSIpLCAiLyIsICLvvI8iKSwgIjoiLCAi77yaIiksICIqIiwgIu+8iiIpCiAgICBzdGcgPSBSZXBsYWNlKFJlcGxhY2UoUmVwbGFjZShSZXBsYWNlKHN0ZywgIj8iLCAi77yfIiksICI8IiwgIu+8nCIpLCAiPiIsICLvvJ4iKSwgInwiLCAi772cIikKICAgIHN0ZyA9IFJlcGxhY2Uoc3RnLCAiIiIiLCBDaHIoJkg4MTY4KSkKICAgIE5HTmFycm93VG9XaWRlID0gc3RnCkVuZCBGdW5jdGlvbgon44OV44Kh44Kk44Or5ZCN44OB44Kn44OD44KvClByaXZhdGUgRnVuY3Rpb24gY2hlY2tfZmlsZXMoQnlWYWwgb2xkZm5hbWUgQXMgU3RyaW5nLCBCeVZhbCBuZXdmbmFtZSBBcyBTdHJpbmcsIEJ5UmVmIG9sZHBhdGggQXMgU3RyaW5nLCBCeVJlZiBuZXdwYXRoIEFzIFN0cmluZykgQXMgQm9vbGVhbgogICAgY2hlY2tfZmlsZXMgPSBGYWxzZQogICAgSWYgTENhc2UoUmlnaHQob2xkZm5hbWUsIDQpKSA8PiAiLnBkZiIgVGhlbgogICAgICAgIE1zZ0JveCAob2xkZm5hbWUgJiAi44Gu5ouh5by15a2Q44GM5LiN5q2j44Gn44GZIikKICAgICAgICBFeGl0IEZ1bmN0aW9uCiAgICBFbmQgSWYKICAgIG9sZHBhdGggPSBUaGlzV29ya2Jvb2sucGF0aCAmICJcIiAmIG9sZGZuYW1lCiAgICBJZiBEaXIob2xkcGF0aCkgPSAiIiBUaGVuCiAgICAgICAgTXNnQm94IChvbGRmbmFtZSAmICLjgYzlrZjlnKjjgZfjgb7jgZvjgpMiKQogICAgICAgIEV4aXQgRnVuY3Rpb24KICAgIEVuZCBJZgogICAgbmV3cGF0aCA9IFRoaXNXb3JrYm9vay5wYXRoICYgIlwiICYgbmV3Zm5hbWUKICAgIElmIERpcihuZXdwYXRoKSA8PiAiIiBUaGVuCiAgICAgICAgRGltIHJjIEFzIEludGVnZXIKICAgICAgICByYyA9IE1zZ0JveChuZXdmbmFtZSAmICLjga/ml6LjgavlrZjlnKjjgZnjgovlkI3liY3jgafjgZkiICYgdmJDckxmICYgIuOBr+OBhOOCkuaKvOOBmeOBqOaXouWtmOODleOCoeOCpOODq+OBr+WJiumZpOOBleOCjCIgJiB2YkNyTGYgJiAi44Oq44ON44O844Og44OV44Kh44Kk44Or44Gr572u44GN5o+b44GI44KJ44KM44G+44GZIiwgdmJZZXNObywgIue9ruOBjeaPm+OBiOeiuuiqjSIpCiAgICAgICAgSWYgcmMgPD4gdmJZZXMgVGhlbgogICAgICAgICAgICBNc2dCb3ggIuWHpueQhuOCkuS4reatouOBl+OBvuOBl+OBnyIKICAgICAgICAgICAgRXhpdCBGdW5jdGlvbgogICAgICAgIEVuZCBJZgogICAgRW5kIElmCiAgICBjaGVja19maWxlcyA9IFRydWUKRW5kIEZ1bmN0aW9uCifjg5XjgqHjgqTjgorlkI3lpInmm7QKUHJpdmF0ZSBTdWIgY2hhbmdlX25hbWUoQnlWYWwgb2xkcGF0aCBBcyBTdHJpbmcsIEJ5VmFsIG5ld3BhdGggQXMgU3RyaW5nKQogICAgSWYgRGlyKG5ld3BhdGgpIDw+ICIiIFRoZW4KICAgICAgICBBcHBsaWNhdGlvbi5EaXNwbGF5QWxlcnRzID0gRmFsc2UKICAgICAgICBLaWxsIG5ld3BhdGgKICAgICAgICBBcHBsaWNhdGlvbi5EaXNwbGF5QWxlcnRzID0gVHJ1ZQogICAgRW5kIElmCiAgICBOYW1lIG9sZHBhdGggQXMgbmV3cGF0aApFbmQgU3ViCg==