選択ファイル（フルパス名）をアクティブセルから表示

質問

ダイアログボックスが自動的に開き選択ファイル（フルパス名）
が表示されるVBEがあるんですが、（下記参照）改良したい点がありますので見て下さい。

Sub Excelファイル()

Dim i As Integer
Dim xFileNames As Variant, xFile As Variant, xDir As String

With Application.FileDialog(msoFileDialogFilePicker)
xFileNames = Application.GetOpenFilename( _
FileFilter:="Excel ファイル (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm", MultiSelect:=True)
If IsArray(xFileNames) Then
i = 1
For Each xFile In xFileNames 'Xファイルネーム（フルパス名）すべての要素に同じ処理を繰り返す
xDir = Dir(xFile) '変数xDir=xファイル名（ファイル名）
If i = 1 Then 'i=1の場合（選択ファイル一つ目の場合）

Cells(i, 1).Value = Replace(xFile, xDir, "") 'A列の中にフルパスからファイル名を取り除いた値を表示する
Cells(i, 1).Offset(1).Value = xDir '1行下の値がファイル名である。
i = i + 2 'iに2を加えてループ
Else '違う場合
Cells(i, 1).Value = xDir 'A列に順にファイル名を表示する
i = i + 1 'ｉに1を加えてループ
End If

Next xFile 'xファイルに戻る
End If
Cells(Rows.Count, 1).End(xlUp).Offset(1).Activate 'データの最終行をA列で検知して一つ下の行がアクティブセル

End With
End Sub

この命令文だとA1セルから縦に順にフルパス名が表示され、データの最終行の一つ下がアクティブセルになるようになっています。

改良したい点は、A列限定ではなくアクティブセルから順に上記と同じようにフルパス名が表示され、データの最終行の一つ下にアクティブセルがくるVBEに改良したいです。
※上記VBEのようにアクティブセルに選択ファイル一つ目のフルパスからファイル名を取り除いたデータを表示し、
　　Offset(1,0)に選択ファイル一つ目のファイル名のみを表示、Offset2以降は選択ファイル2つ目以降のファイル名だけを表示するようにする。

VBA初心者なので、上記のようにそれほど難しくない構文で仕上げたいのですが、
もしできる方いましたら教えてください。
よろしくお願いいたします。

回答No.1

queuerev2

質問投稿後かなり日数がたっていますが今でもお役にたてるでしょうか。

とりあえず最低限の修正をしてみました。
修正点は以下の通りです。
１．iの型はIntegerからLongに（32768行以下に対応）
２．i（行番号）の初期値を1からActiveCell.Rowに変更。
　（選択ファイル一つ目かどうかの判定も同様に変更）
３．Cellsの列番号を1からActivecell.Columnに変更

コードは以下の通りです。
Sub Excelファイル()

Dim i As Long
Dim xFileNames As Variant, xFile As Variant, xDir As String

With Application.FileDialog(msoFileDialogFilePicker)
xFileNames = Application.GetOpenFilename( _
FileFilter:="Excel ファイル (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm", MultiSelect:=True)
If IsArray(xFileNames) Then
i = ActiveCell.Row
For Each xFile In xFileNames 'Xファイルネーム（フルパス名）すべての要素に同じ処理を繰り返す
xDir = Dir(xFile) '変数xDir=xファイル名（ファイル名）
If i = ActiveCell.Row Then 'i=アクティブセルの行の場合（選択ファイル一つ目の場合）
Cells(i, ActiveCell.Column).Value = Replace(xFile, xDir, "") 'A列の中にフルパスからファイル名を取り除いた値を表示する
Cells(i, ActiveCell.Column).Offset(1).Value = xDir '1行下の値がファイル名である。
i = i + 2 'iに2を加えてループ
Else '違う場合
Cells(i, ActiveCell.Column).Value = xDir 'A列に順にファイル名を表示する
i = i + 1 'ｉに1を加えてループ
End If

Next xFile 'xファイルに戻る
End If
Cells(Rows.Count, ActiveCell.Column).End(xlUp).Offset(1).Activate 'データの最終行をA列で検知して一つ下の行がアクティブセル

End With
End Sub

ところで、最後のアクティブセルを移動するところですが、このプロシージャを複数回使用してその結果を連続したセルに表示するなら、以下のようにした方がいいのではないでしょうか。
Cells(i, ActiveCell.Column).Activate