[[20170114112254]]　『ファイル名一覧取得とリネームマクロ』（さや）　ページの最後に飛ぶ

『ファイル名一覧取得とリネームマクロ』（さや）

下記のマクロを変更したいのですが、教えていただけませんか。

変更したい内容
・Sheet(1)の前にシート追加するようになっていますが、Sheet(1)自体に出したい。
Worksheets.Add Before:=Sheets(1)　をどうすればいいのか。

・A1～4行目までは予め項目を入れておき、5行目以降にマクロを反映させたい。
項目名は下記にする予定
A4：変更前のファイル名
B4：変更後のファイル名
C4：実行結果

Sub フォルダを指定してファイル名一覧を作成する()

  Dim dlg As FileDialog
  Dim fd_path As String  'フォルダのフルパス
  Dim fl_name As String  'ファイル名
   Dim i As Long  'ファイル名を出力する行番号

  Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
  'キャンセル時にはマクロを終了
   If dlg.Show = False Then Exit Sub

   'フォルダのフルパスを格納
   fd_path = dlg.SelectedItems(1)

  'フォルダ内の一つ目のファイル名を取得
   fl_name = Dir(fd_path & "\*")
  If fl_name = "" Then
    MsgBox fd_path & " にはファイルが存在しません。"
    Exit Sub
  End If

  Worksheets.Add Before:=Sheets(1)

  Range("A1").Value = fd_path
  Range("A2").Value = "のファイル一覧"
  Range("A4").Value = "ファイル名"

  'A5セルから下にファイル名を書き出し
  i = 5
  Do Until fl_name = ""
    Cells(i, "A").Value = fl_name
    i = i + 1
    '次のファイル名を取得
     fl_name = Dir
  Loop

  MsgBox Sheets(1).Name & "にファイル名一覧を作成しました。"

End Sub

Sub ファイル名をまとめて変更する()
'アクティブシートのA列に入力されているファイル名を
'B列に入力されているファイル名に変更する
'
'A1セルに、ファイル名を変更したいフォルダのフルパスを入力しておいてください
'A5セル以下に、現在のファイル名を入力しておいてください
'B5セル以下に、新しいファイル名を入力しておいてください
'C5セル以下には実行結果が自動的に入力されます

  Dim fp As String
  Dim i As Long
  Dim fo As String
  Dim fn As String

  'パスを変数に格納
   fp = Range("A1").Value & "\"

  On Error GoTo ERR_HANDL

  Range("C4").Value = "実行結果"

  '5行目から最終行までループ処理を実行
   For i = 5 To Cells(Rows.Count, 1).End(xlUp).Row
    '現在のファイル名を取得
     fo = Cells(i, 1).Value
    '新しいファイル名を取得
     fn = Cells(i, 2).Value
    '新しいファイル名が入力されているときのみ処理を実行
     If fn <> "" Then
      '正常処理の実行結果を先に入力
       Cells(i, 3).Value = _
        "○ファイル名を" & _
        "「" & fo & "」から" & _
        "「" & fn & "」に変更しました。"
      'ファイル名を変更
       Name fp & fo As fp & fn
    End If
  Next i

  Exit Sub

ERR_HANDL:

   Cells(i, 3).Value = _
    "×" & Err.Description & ":" & Err.Number
  Resume Next

End Sub

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 ２つのプロシジャがアップされていますが、質問は　Sub フォルダを指定してファイル名一覧を作成する() 　のほうですね。

 説明はよく読んでいませんが、アップされたコードに

 Worksheets.Add Before:=Sheets(1) 　　がありますね。

 新しいシートが追加され、それがアクティブシートになります。
 で、以降は　Range("A1").Value = fd_path 等　アクティブシートを前提としたコード記述になっています。
 （これは、あまり感心しませんが、まぁ、それはさておきましょう）

 ですから、Worksheets.Add Before:=Sheets(1)　これを消します。

 かわりに Sheets(1).Activate といれておけば、コード修正は最小限ですみます。

 あるいは、Sheets(1) を アクティブシートの状態で実行すれば　Sheets(1).Activate も不要です。

 （繰り返します。あまり感心しません。本来なら　セル領域が、どのシートなのかを明示するようなコード記述が望ましいです）

 留意点としては、従来は、新規シートが作られましたから、つねに最初はからっぽ。
 今回は既存シートに書きこみますね。　仮に、前回処理をして　100件表示されていた、今回 80件だったという場合
 前回の81件目～100件目が残りっぱなしになって、閲覧した人が勘違いするかもしれません。

 実行前に手作業で、抽出領域をクリアしておくか、あるいはマクロの最初にクリアコードをいれるか、
 いずれかが必要ですね。

（β） 2017/01/14(土) 11:49

βさん

ありがとうございました。

ご指摘頂いたようにクリアコードも入れて修正できました。

助かりました。

さや
（さや） 2017/01/14(土) 12:12

コメント返信：

[ 一覧(最新更新順) ]

[[20170114112254]] 『ファイル名一覧取得とリネームマクロ』（さや） ページの最後に飛ぶ

[[20170114112254]]　『ファイル名一覧取得とリネームマクロ』（さや）　ページの最後に飛ぶ