Excel ブックのリネームがうまくできません

質問

windows10,microsoft365使用の超初心者です。
デスクトップにフォルダ「計算」があります。その中に令和２年度計算.xlsmとフォルダ「実績」があります。フォルダ実績の中に令和２年９月実績.xlsxがあります。
このファイルの名前を変えたくて、下記コードをみつけました。
実行するとダイアログボックスに、令和２年度計算.xlsmと入っています。このボックスのなかに令和２年９月実績.xlsxを表示するには、
コードをどう変えたらいいか教えていただきたいです。よろしくお願いします。
Sub File_Name()
Dim Cur_Path As String 'ファイルのパス'
Dim Cur_Name As String '元のファイル名'
Dim New_Name As String '変更後のファイル名'
'ファイルのパス、ファイル名の読み込み'
Cur_Path = ThisWorkbook.Path
Cur_Name = ThisWorkbook.Name
'インプットボックスの表示とファイル名の変更'
New_Name = InputBox(Prompt:="ファイル名を入力して下さい。", Default:=Cur_Name)
'「キャンセルボタン」または「×ボタン」を押した場合'
If New_Name = "" Then
Exit Sub
Else
End If
'ファイルの別名保存して閉じて再度開く'
ThisWorkbook.SaveAs Cur_Path & "\" & New_Name
Workbooks.Open Cur_Path & "\" & New_Name
'ファイルの別名保存して閉じて再度開く'
If Cur_Path & "\" & New_Name <> Cur_Path & "\" & Cur_Name Then
Kill Cur_Path & "\" & Cur_Name
Else
End If
End Sub

回答No.10

kkkkkm · ベストアンサー

> 実行時エラー9　インデックスが有効範囲にありません　となります。

マクロを実行しているブックのシート名がSheet1のA1に10月と入っていますか？

お礼

ありがとうございました。お陰様で出来るようになりました。

回答No.9

kkkkkm

ちなみにNo7の

InitialFileName:="令和２年９月実績.xlsx",

の"令和２年９月実績.xlsx"
は実際に保存したい名前を入れてください。

たとえばSheet1のA1に10月と入っているとしたら
InitialFileName:="令和２年" & Sheets("Sheet1").Range("A1").Value & "実績.xlsx", _
とかです。

補足

ご指摘のとおり修正しましたが、実行時エラー9　インデックスが有効範囲にありません　となります。

回答No.8

kkkkkm

> VBA コード説明

ありがとうございます。

で、

> また ThisWorkbook.Name はファイル名になり、今回の場合
> 「テスト.xlsm」
> になります。
> これを変数 Cur_Name に代入します。

If Cur_Path & "\" & New_Name <> Cur_Path & "\" & Cur_Name Then
Kill Cur_Path & "\" & Cur_Name
Else
が実行されたとして元のテスト.xlsm(実際は令和２年度計算.xlsmでしょうか)が削除されるわけですがいいんですか？
Killは削除ですよ。
実際はこの部分は実行されないと思いますが。

結局そのコードではマクロを実行しているファイルの名前を
InputBox(Prompt:="ファイル名を入力して下さい。",
で指定したファイル名に変更するだけです。マクロ有を無しのファイル名では保存できませんが(古いマクロ有と無しが同じ拡張子だったころならマクロ有を無しで保存できると思います)

ここでマクロ実行しているファイルをそのブックのフォルダへ新しい名前で保存してるだけ。
ThisWorkbook.SaveAs Cur_Path & "\" & New_Name

なので、別名で保存と同じです。

> 次のコードのとおりになれば有難いのですが・・。

コード通りならそのまま実行すればいいのでは？

> VBAで前のファイル令和2年9月実績.xlsxを削除したい

その動作は元のコードにはまったく存在しません。
InputBox(Prompt:="ファイル名を入力して下さい。",
に令和２年９月実績.xlsxを入れてそれが削除されると考えているのでしたら勘違いです。

示されたコードは

> 自分としては実績フォルダに令和２年１０月実績.xlsxをつくって、令和２年９月実績.xlsx を削除

するために考えられたコードではありません。

動作としてはマクロを実行しているブックの新しい名前をInputBox(元の名前を取り合えず入れておく)で取得してその名前で保存し、名前が変更されたら元のファイル(マクロを実行していたブック)を削除するという事を期待するコードです。実際は削除されない。

回答No.7

kkkkkm

No6です。
削除するタイミングが、No6はマクロを実行したら即削除だったのですが、ダイアログでキャンセルしたのに削除されているのは困るかもしれないので、別名で保存を決定したときに削除するタイミングにしたこちらのほうがいいかもしれません。

Sub Test2()
Dim NewFileName As Variant

ChDir ThisWorkbook.Path & "\実績"
NewFileName = Application.GetSaveAsFilename( _
InitialFileName:="令和２年９月実績.xlsx", _
FileFilter:="Excelファイル,*.xlsx,Excelマクロブック,*.xlsm", _
FilterIndex:=1)
If NewFileName = False Then
Exit Sub
End If
If Dir(ThisWorkbook.Path & "\実績\*.*") <> "" Then
Kill ThisWorkbook.Path & "\実績\*.*"
End If
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs NewFileName, XlFileFormat.xlWorkbookDefault
Application.DisplayAlerts = True
End Sub

補足

ご指摘のとおり実行しましたが、同じでした。僕の説明がおかしいのかもしれません。次のコードのとおりになれば有難いのですが・・。
Sub File_Name()
Dim Cur_Path As String 'ファイルのパス'
Dim Cur_Name As String '元のファイル名'
Dim New_Name As String '変更後のファイル名'
'ファイルのパス、ファイル名の読み込み'
Cur_Path = ThisWorkbook.Path
Cur_Name = ThisWorkbook.Name
'インプットボックスの表示とファイル名の変更'
New_Name = InputBox(Prompt:="ファイル名を入力して下さい。", Default:=Cur_Name)
'「キャンセルボタン」または「×ボタン」を押した場合'
If New_Name = "" Then
Exit Sub
Else
End If
'ファイルの別名保存して閉じて再度開く'
ThisWorkbook.SaveAs Cur_Path & "\" & New_Name
Workbooks.Open Cur_Path & "\" & New_Name
'ファイルの別名保存して閉じて再度開く'
If Cur_Path & "\" & New_Name <> Cur_Path & "\" & Cur_Name Then
Kill Cur_Path & "\" & Cur_Name
Else
End If
End Sub

VBA コード説明
変数の定義
まずは変更の定義です。
Dim Cur_Path As String 'ファイルのパス'
Dim Cur_Name As String '元のファイル名'
Dim New_Name As String '変更後のファイル名'
ファイルのパス、元のファイルの名前、変更後のファイルの名前を文字列型で定義しています。
ファイルのパス、ファイル名の代入
次は変数にファイルのパスとファイル名を代入するところです。
Cur_Path = ThisWorkbook.Path
Cur_Name = ThisWorkbook.Name
ThisWorkbook.Path とは、この VBA コードが書かれたフォルダのパスです。
ファイル名が「テスト.xlsm」のファイルがデスクトップにあったとします。
ファイルのパスは以下のようになります。
「C:\Users\aaa\Desktop\テスト.xlsm」
この場合、ThisWorkbook.Path はファイル名よりも前の部分の
「C:\Users\aaa\Desktop」
になります。
これを変数 Cur_Path に代入します。
また ThisWorkbook.Name はファイル名になり、今回の場合
「テスト.xlsm」
になります。
これを変数 Cur_Name に代入します。
インプットボックスの表示とファイル名の変更
インプットボックスを表示すると同時に、現在のファイルの名前を表示させています。
New_Name = InputBox(Prompt:="ファイル名を入力して下さい。", Default:=Cur_Name)1
New_Name = InputBox(Prompt:="ファイル名を入力して下さい。", Default:=Cur_Name)
「Prompt:=”ファイル名を入力して下さい。”」 とすることで、このメッセージがボックスに表示されます。
また、「Default:=Cur_Name」とすることで、ボックスが開いた状態で現在のファイル名が入っています。

回答No.6

kkkkkm

> フォルダには必ず１個のファイルしかない、

のでしたら、実績フォルダの中にあるすべてのファイルを削除する以下のコードで試してみてください。

Sub Test2()
Dim NewFileName As Variant

ChDir ThisWorkbook.Path & "\実績"
If Dir(ThisWorkbook.Path & "\実績\*.*") <> "" Then
Kill ThisWorkbook.Path & "\実績\*.*"
End If
NewFileName = Application.GetSaveAsFilename( _
InitialFileName:="令和２年９月実績.xlsx", _
FileFilter:="Excelファイル,*.xlsx,Excelマクロブック,*.xlsm", _
FilterIndex:=1)
If NewFileName = False Then
Exit Sub
End If
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs NewFileName, XlFileFormat.xlWorkbookDefault
Application.DisplayAlerts = True
End Sub

回答No.5

kkkkkm

No3です。

単に別名で保存したいのでしたら(名前を付けて保存ダイアログを出す)

Sub Test2()
Dim NewFileName As Variant

ChDir ThisWorkbook.Path & "\実績"
NewFileName = Application.GetSaveAsFilename( _
InitialFileName:="令和２年９月実績.xlsx", _
FileFilter:="Excelファイル,*.xlsx,Excelマクロブック,*.xlsm", _
FilterIndex:=1)
If NewFileName = False Then
Exit Sub
End If
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs NewFileName, XlFileFormat.xlWorkbookDefault
Application.DisplayAlerts = True
End Sub

補足

kkkkkmさま　ありがとうございます。教えて頂いコードで充分なのですが、再度ファイルを開いた時に、フォルダには必ず１個のファイルしかない、という条件でしか開けないマクロを設定していますので、手て削除するのは面倒なので、VBAで前のファイル令和2年9月実績.xlsxを削除したいのです。

回答No.4

masnoske

No.1 です．
何をしたいのかが書かれていないため，思うような回答ができません．

ThisWorkbook.SaveAs Cur_Path & "\" & New_Name
このオリジナルのコードは，マクロが書かれたファイル（ThisWorkbook）を保存するコードです．
マクロが書かれているファイルですから，あなたが要求された「令和２年９月実績.xlsx」で保存できないのは当然です．
マクロなら「令和２年９月実績.xlsm」でなければなりません．

なので，そもそもこのコードは「令和２年９月実績.xlsm」を「令和２年９月実績.xlsx」にして保存するコードではありません．
とりあえず，マクロの記録を使って「令和２年９月実績.xlsm」を「令和２年９月実績.xlsx」にして保存すれば，お求めのコードを得られるはずです．

回答No.3

kkkkkm

質問に記載しているコードはマクロを実行しているファイルのファイル名を変更するというコードになりますので、令和２年９月実績.xlsxのファイル名を変更したいということでしたらいかの方法で試してみてください。

ファイルを開くダイアログが出ますのでそこで変更していファイルを選択します。選択後にフォルダ名を含めたファイル名が記載されたボックスが出ますのでファイル名だけを変更して下さい。

Sub Test()
Dim OldFileName As String
Dim NewFileName As String
Dim mPath As String

ChDir ThisWorkbook.Path & "\実績"
mPath = ThisWorkbook.Path & "\実績"
OldFileName = Application.GetOpenFilename("Excel ブック,*.xls?")
If OldFileName = "False" Then Exit Sub
NewFileName = InputBox(Prompt:="ファイル名を入力して下さい。", Default:=OldFileName)
If NewFileName = OldFileName Then
MsgBox "新旧ファイル名が同じです。", vbInformation
Else
Name OldFileName As NewFileName
End If
End Sub

回答No.2

dell_OK

「実績」フォルダに、また、現在のブック「.xlsm」形式を「.xlsx」形式に変更して保存し、開いてます。
ThisWorkbook.SaveAs Cur_Path & "\実績\" & New_Name, XlFileFormat.xlWorkbookDefault
Workbooks.Open Cur_Path & "\実績\" & New_Name

補足

教えていただいたコード実行しました。するとデバックになり、実行時エラー５３　　ファイルが見つかりませんとなり
最後の Kill Cur_Path & "￥実績￥" & Cur_Nameの一行が黄色になってしまいます。
よく見るとフォルダ「計算」の中に令和２年度計算.xlsmと先ほど作られた令和２年１０月実績.xlsx とフォルダ「実績」がありました。その中を覗くと令和２年９月実績.xlsx がありました。
自分としては実績フォルダに令和２年１０月実績.xlsxをつくって、令和２年９月実績.xlsx を削除したいのですが・・・面倒お掛けし申し訳ございません。よろしくお願いいたします。

回答No.1

masnoske

New_Name = InputBox(Prompt:="ファイル名を入力して下さい。", Default:=Cur_Name)
このコードでテキストボックスのデフォルトに Cur_Nameという変数が指定されています．
つまり，Cur_Nameに希望するブック名を入力すれば良いです．
Cur_Nameに値をセットしているのは，以下のコードです．
Cur_Name = ThisWorkbook.Name
つまり，マクロが記述されているブックの名前をセットしています．
なので，これをとすればOKです．
Cur_Name = "令和２年９月実績.xlsx"

補足

Cur_Name = ThisWorkbook.Name の所を
Cur_Name = ”令和２年９月実績.xlsx”に変更すると
ダイアログボックスに「令和２年９月実績.xlsx」が表示されたので、ＯＫすると
実行時エラー1004　この拡張子は選択したファイル形式には使用できません。と出て進まないのです。