前画面へ戻る

Sub Macro2()

'このマクロは､任意のExcelファイルを開いてそのシート名を取得する方法を編集しています｡

'変数の宣言
Dim Flt
Dim ImanoFile 'MacroFile
Dim ImanoSheet 'MacroSheet
Dim FileName 'OpenFile
Dim SheetName() 'OpenSheet
Dim i As Integer
Dim ShtCnt As Integer 'Sheetカウント変数
Dim SheetMei

'-----------シートデータ　クリア--------
Cells.Select 'シート全体を選択
With Selection
　.ClearContents 'データのクリア
　.ClearFormats '書式のクリア
End With

'--------------------------------------
'現在のファイル名の取得
ImanoFile = ActiveWorkbook.Name
'現在のシート名の取得
ImanoSheet = ActiveSheet.Name

MsgBox ("このファイル名：" & ImanoFile & Chr(13) & Chr(10) & _
" ,このシート名：" & ImanoSheet)

'----------------------------------------------------------
MsgBox ("エクセルブックを開いて下さい")

'Openするファイルの種類
Flt = "Excelファイル(*.xls),*.xls"
'｢ファイルを開く｣ダイアログOpen
FileName = Application.GetOpenFilename(Flt)

'ファイル名がなかったら終了
If FileName = False Then
　Exit Sub
End If

'ファイルOpen
Workbooks.Open FileName

'Openファイル名の取得
FileName = ActiveWorkbook.Name

'-----------------------------------------------------------
'シートをカウント
ShtCnt = Application.Sheets.Count

'空領域の配列変数にメモリを割り当てる
ReDim SheetName(ShtCnt)

'メッセージ表示の初期設定
SheetMei = ""

For i = 1 To ShtCnt
'配列変数にシート名を代入する
　SheetName(i) = Workbooks(FileName).Sheets(i).Name

'メッセージをつなげる(& Chr(13) & Chr(10)　は改行コード)
　SheetMei = SheetMei & "＜" & SheetName(i) & "＞" & Chr(13) & Chr(10)
Next i

MsgBox ("Openしたファイル名は〔" & FileName & "〕" & Chr(13) & Chr(10) & _
"シートは" & ShtCnt & "枚" & Chr(13) & Chr(10) & _
"シート名" & Chr(13) & Chr(10) & SheetMei)

'-----------------------------------------------
'ファイル名とシート名の表示
Workbooks(ImanoFile).Sheets(ImanoSheet).Activate
Range("A1").Select
With ActiveSheet
　.Cells(6, 2).Value = "ファイル名"
　.Cells(6, 3).Value = Workbooks(FileName).Name
　.Cells(7, 2).Value = "シート名"
End With

For i = 1 To ShtCnt
　ActiveSheet.Cells(7 + i - 1, 3).Value = SheetName(i)
Next i

'Openしたファイルの表示
'Workbooks(FileName).Sheets(1).Activate
'Range("A1").Select

End

End Sub

お土産　Macro2.zip

前画面へ戻る