【マクロ】シート名を取得する為には

【やりたい事】
ファイル名とシート名を取得したい。
ファイル名は、A１セルに記述。
シート名は、B1セルに記述。

記述すファイルは、ファイル探す.xlsm

なお、ファイル名を記述するコードは以下のとおりできています。

本コード利用でも、別コードでOKでございます。
ご存じの方、いましたら、教えて下さい


【取得したファイルとシート名】
（シート名）
Sheet1

（ファイル名）
C:\Users\2020\OneDrive\Shinji\マクロ\テストフォルダ\a.xlsx



【マクロが記録されているファイル】
ファイル探す.xlsm
※探すファイルとは別フォルダ



【ファイル名をAセルに記録するコード】
※本サイトにて、詳しい方に、教えて頂きました

Sub GetFileName()


Dim myPath As String
Dim myFile As String


myPath = "C:\Users\2020\OneDrive\マクロ\テストフォルダ"


myFile = Dir(myPath & "\*.*")


If myFile <> "" Then


Range("A1").Value = myPath & "\" & myFile



Else
MsgBox "ファイルが見つかりませんでした。"
End If


End Sub

No.2 回答者： zongai 回答日時： 2024/05/02 10:03

コメント拝見しました。

シート名を書き出すのが『B1セルから』であることを、コードを見たときに理解しやすくする、ということであれば、
以下のような書き換えではいかがでしょうか。

ThisWorkbook.ActiveSheet.Cells(1, i + 1).Value = ws.Name
　　　↓
ThisWorkbook.ActiveSheet.Range("B1").Offset(0, i - 1).Value = ws.Name

No.1 回答者： zongai 回答日時： 2024/05/02 07:55

シート数がいくつあるかわかりませんので、

存在する分をB1、C1とか気並べるようにしています。

Sub GetFullFilePathAndSheetNames()
　　Dim myPath As String
　　Dim myFile As String
　　Dim wb As Workbook
　　Dim ws As Worksheet
　　Dim i As Integer
　　
　　' フォルダのパスを設定
　　myPath = "C:\Users\user\Documents\Aフォルダ"
　　
　　' 指定されたパスのファイルを取得
　　myFile = Dir(myPath & "\*.*")
　　
　　' ファイルが存在する場合は、A1セルにファイルのフルパスを書き込む
　　If myFile <> "" Then
　　　　Range("A1").Value = myPath & "\" & myFile
　　Else
　　　　MsgBox "ファイルが見つかりませんでした。"
　　　　Exit Sub
　　End If
　　
　　' A1セルに書き込んだファイルを開く
　　Set wb = Workbooks.Open(Range("A1").Value)
　　
　　' B1以降にシート名を書き込む
　　i = 1
　　For Each ws In wb.Sheets
　　　　ThisWorkbook.ActiveSheet.Cells(1, i + 1).Value = ws.Name
　　　　i = i + 1
　　Next ws
　　
　　' ファイルを閉じる
　　wb.Close False
End Su

この回答へのお礼

早速のお返事ありがとうございます

B1セルにも、シート名がうまく、表示されました
ちなみに、セルを　Range("b1").Value のように
表示する事はできないでしょうか。

というのは、ファイル名やシート名のセルを記述する場所を
後で、変更する予定がある為です

最終的には、当該ファイル名とシート名を利用して
他のコードを動かす予定です。

また、それは質問いたします

お礼日時：2024/05/02 09:32