修正
This commit is contained in:
BIN
機能仕様書作成.xlsm
BIN
機能仕様書作成.xlsm
Binary file not shown.
@@ -191,3 +191,4 @@ Sub ExportCustomizeFunctionsToMarkdownFile()
|
|||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
78
機能仕様書作成/Module2.bas
Normal file
78
機能仕様書作成/Module2.bas
Normal 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
|
||||||
Reference in New Issue
Block a user