79 lines
1.9 KiB
QBasic
79 lines
1.9 KiB
QBasic
Attribute VB_Name = "Module2"
|
||
Option Explicit
|
||
|
||
Sub ExcelFileImport()
|
||
|
||
Application.ScreenUpdating = False
|
||
|
||
Dim fd As FileDialog
|
||
Dim selectedPath As String
|
||
Dim wb As Workbook
|
||
Dim ws As Worksheet
|
||
Dim sheetList As String
|
||
|
||
|
||
Dim tgtSheet As Worksheet
|
||
Set tgtSheet = ActiveSheet
|
||
|
||
'========================
|
||
' ファイル選択ダイアログ
|
||
'========================
|
||
Set fd = Application.FileDialog(msoFileDialogFilePicker)
|
||
With fd
|
||
.title = "Excelファイルを選択してください"
|
||
.Filters.Clear
|
||
.Filters.Add "Excelファイル", "*.xlsx; *.xlsm; *.xls"
|
||
.AllowMultiSelect = False
|
||
|
||
If .Show <> -1 Then Exit Sub
|
||
selectedPath = .SelectedItems(1)
|
||
End With
|
||
|
||
'========================
|
||
' ファイルパスを C3 に出力
|
||
'========================
|
||
tgtSheet.Range("C3").Value = selectedPath
|
||
|
||
'========================
|
||
' 出力先初期化
|
||
'========================
|
||
tgtSheet.Range("C4").MergeArea.ClearContents
|
||
sheetList = ""
|
||
|
||
'========================
|
||
' Excelファイルを開く
|
||
'========================
|
||
Set wb = Workbooks.Open(Filename:=selectedPath, ReadOnly:=True)
|
||
|
||
'========================
|
||
' シート名を連結（セル内改行）
|
||
'========================
|
||
For Each ws In wb.Worksheets
|
||
If sheetList = "" Then
|
||
sheetList = ws.Name
|
||
Else
|
||
sheetList = sheetList & vbLf & ws.Name
|
||
End If
|
||
Next ws
|
||
|
||
'MsgBox (sheetList)
|
||
|
||
'========================
|
||
' C5（結合セル）に出力
|
||
'========================
|
||
With tgtSheet.Range("C4")
|
||
.MergeArea.Value = sheetList
|
||
.WrapText = True
|
||
End With
|
||
|
||
|
||
'========================
|
||
' 後処理
|
||
'========================
|
||
wb.Close SaveChanges:=False
|
||
Set wb = Nothing
|
||
|
||
Application.ScreenUpdating = True
|
||
|
||
End Sub
|