This commit is contained in:
2026-04-06 18:15:12 +09:00
parent ec7e4d08bb
commit 1762dc69de
3 changed files with 79 additions and 0 deletions

View File

@@ -191,3 +191,4 @@ Sub ExportCustomizeFunctionsToMarkdownFile()
End Sub

View File

@@ -0,0 +1,78 @@
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