teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

2

コード修正

2018/06/23 17:43

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -109,7 +109,7 @@
109
109
  'ファイルの取得
110
110
  For Each objFile In objFolder.Files
111
111
  With objFile
112
- If .Name Like "*.xls*" Then
112
+ If .Type = "Microsoft Excel ワークシート" Then
113
113
  i = i + 1
114
114
  TreeView1.Nodes.Add Relative:=PKey, Relationship:=tvwChild, _
115
115
  Key:="n" & i, Text:=.Name

1

コードの追加

2018/06/23 17:43

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -11,4 +11,113 @@
11
11
  [Office TANAKA - Excel VBA Tips[TreeViewコントロールの使い方]](http://officetanaka.net/excel/vba/treeview/index.htm)
12
12
 
13
13
  リストボックスの2列表示については、下記をご参考に。
14
- [Office TANAKA - Excel VBA Tips[複数列のリストボックス]](http://officetanaka.net/excel/vba/tips/tips158.htm)
14
+ [Office TANAKA - Excel VBA Tips[複数列のリストボックス]](http://officetanaka.net/excel/vba/tips/tips158.htm)
15
+
16
+ ツリービューで作成してみた
17
+ ---
18
+ 将来使うことがあるかもしれないので、ツリービューの勉強がてら作成してみました。
19
+
20
+ ![イメージ説明](ab57d1dc1a2151e214598bff0c9c7025.png)
21
+
22
+ ユーザーフォーム上にツリービュー(TreeView1)を配置します。
23
+ 配置の仕方は上記の Office TANAKA のリンク先を参考にしてください。
24
+ 他に下記のコントロールを配置します。
25
+ イメージリストと連携させてアイコンも表示できるようだが、私の環境ではエラーが出てアイコンが登録できなかったのでアイコンはなしです。
26
+
27
+ コマンドボタン
28
+ cmdBookPrint 選択したブックの印刷
29
+ cmdSelectFolder 親フォルダの選択
30
+
31
+ テキストボックス
32
+ txtRootFolder 親フォルダのパス格納用
33
+
34
+ ユーザーフォームのモジュール
35
+ ```vba
36
+ Option Explicit
37
+
38
+ Private Sub cmdBookPrint_Click()
39
+ Dim n As Node
40
+ For Each n In TreeView1.Nodes
41
+ If n.Checked And n.Children = 0 Then
42
+ Debug.Print n.FullPath
43
+ End If
44
+ Next
45
+ End Sub
46
+
47
+ Private Sub cmdSelectFolder_Click()
48
+ With Application.FileDialog(msoFileDialogFolderPicker)
49
+ .InitialFileName = txtRootFolder.Value
50
+ .AllowMultiSelect = False
51
+ .Title = "親フォルダの選択"
52
+ If .Show Then txtRootFolder.Value = .SelectedItems(1)
53
+ End With
54
+ TreeView1.Nodes.Clear
55
+ InitFileTreeView
56
+ End Sub
57
+
58
+ Private Sub UserForm_Initialize()
59
+ txtRootFolder.Value = "C:\PFolder"
60
+ With TreeView1
61
+ .CheckBoxes = True
62
+ .Indentation = 14 ''インデントの幅
63
+ .LabelEdit = tvwManual ''ラベル編集の許可
64
+ .BorderStyle = ccNone ''線の種類
65
+ .HideSelection = False ''非アクティブ時の選択解除
66
+ .LineStyle = tvwRootLines ''ルート(最上位)線の表示
67
+ End With
68
+
69
+ InitFileTreeView
70
+ End Sub
71
+
72
+ Sub InitFileTreeView()
73
+ Dim objFSO As FileSystemObject
74
+ Dim strDir As String
75
+ Dim i As Long
76
+
77
+ strDir = txtRootFolder.Value
78
+ 'FileSystemObjectのインスタンスの生成
79
+ Set objFSO = New FileSystemObject
80
+ 'フォルダの存在確認
81
+ If Not objFSO.FolderExists(strDir) Then
82
+ MsgBox ("指定のフォルダは存在しません")
83
+ Exit Sub
84
+ End If
85
+ '親フォルダーの登録、展開
86
+ TreeView1.Nodes.Add(Key:="n0", Text:=strDir).Expanded = True
87
+ i = 1 'キーインデックス
88
+ '再帰処理モジュールのコール
89
+ Call GetDirFiles(objFSO.GetFolder(strDir), i, "n0")
90
+ 'オブジェクトの解放
91
+ Set objFSO = Nothing
92
+ End Sub
93
+
94
+ Sub GetDirFiles(ByVal objFolder As Folder, ByRef i As Long, ByVal PKey As String)
95
+ Dim objFolderSub As Folder, objFile As File
96
+ Dim n As Node
97
+ 'サブフォルダの取得
98
+ For Each objFolderSub In objFolder.SubFolders
99
+ i = i + 1
100
+ Set n = TreeView1.Nodes.Add(Relative:=PKey, Relationship:=tvwChild, _
101
+ Key:="n" & i, Text:=objFolderSub.Name)
102
+ Call GetDirFiles(objFolderSub, i, "n" & i)
103
+ If n.Children = 0 Then
104
+ TreeView1.Nodes.Remove n.Index
105
+ Else
106
+ n.Expanded = True
107
+ End If
108
+ Next
109
+ 'ファイルの取得
110
+ For Each objFile In objFolder.Files
111
+ With objFile
112
+ If .Name Like "*.xls*" Then
113
+ i = i + 1
114
+ TreeView1.Nodes.Add Relative:=PKey, Relationship:=tvwChild, _
115
+ Key:="n" & i, Text:=.Name
116
+ End If
117
+ End With
118
+ Next
119
+ 'オブジェクトの解放
120
+ Set objFolderSub = Nothing
121
+ Set objFile = Nothing
122
+ End Sub
123
+ ```