teratail
回答率
85.31%
teratail header banner
teratail header banner
質問するログイン新規登録
トップに関する質問VBA リストボックスの表示について

編集履歴

質問編集履歴

2

コードの修正

2020/06/16 01:58

投稿

kano_036
kano_036

スコア1

test CHANGED
File without changes
test CHANGED
@@ -20,7 +20,7 @@
20
20
 
21
21
  ### 該当のソースコード!
22
22
 
23
-
23
+ ```ここに言語を入力
24
24
 
25
25
  Option Explicit
26
26
 
@@ -268,6 +268,6 @@
268
268
 
269
269
  End Sub
270
270
 
271
-
271
+ ```
272
272
 
273
273
  ![イメージ説明](bf4abc7958a45598669cd6569dfbd794.png)

1

ソースコードの修正と説明の補足

2020/06/16 01:58

投稿

kano_036
kano_036

スコア1

test CHANGED
File without changes
test CHANGED
@@ -8,74 +8,266 @@
8
8
 
9
9
  というものを作成したのですが文字数が多いものは枠から
10
10
 
11
- はみ出る形で見栄えが悪いので表示できる文字数を制限したいのですが
11
+ はみ出る形で見栄えが悪いので表示するときのみ文字数を制限したいのでしょうか？
12
-
13
- いい方法はありますでしょうか？
12
+
14
-
15
- 文字数がはみ出るのはソースコードのUserForm1.TextBox1.Valueのみになります。
13
+ 出来るのであれば下記の画像のようにしてみたいと思ってます。
14
+
15
+
16
16
 
17
17
  ソースコードはネットのサンプルを少し治したものになります
18
18
 
19
19
 
20
20
 
21
- ### 該当のソースコード
21
+ ### 該当のソースコード!
22
+
23
+
24
+
22
-
25
+ Option Explicit
26
+
23
-
27
+ '連絡ツールのリストボックス
28
+
29
+ Private Sub UserForm_Initialize()
30
+
31
+ With ContactTool
32
+
33
+ .AddItem "電話"
34
+
35
+ .AddItem "Cメール"
36
+
37
+ .AddItem "社内メール"
38
+
39
+ .AddItem "Line"
40
+
41
+ .AddItem "Slack"
42
+
43
+ .AddItem "その他"
44
+
45
+ End With
46
+
47
+
48
+
49
+ End Sub
50
+
51
+
52
+
53
+ '登録確認
54
+
55
+ Private Sub Registration_Click()
56
+
57
+
58
+
59
+ If UserForm1.NameBox.Value = "" Or UserForm1.TextBox1.Value = "" Then
60
+
61
+ MsgBox "未入力があります"
62
+
63
+ Else
64
+
65
+ Call UserForm1.Registration_Click2
66
+
67
+
68
+
69
+ End If
70
+
71
+
72
+
73
+ End Sub
74
+
75
+ 'エクセルに登録
24
76
 
25
77
  Sub Registration_Click2()
26
78
 
27
- Dim Name As Long
28
-
29
- Dim rc As VbMsgBoxResult
30
-
31
-
32
-
33
- Name = 1
34
-
35
-
36
-
37
- Do Until Cells(Name, 1) = ""
38
-
39
- Name = Name + 1
40
-
41
- Loop
42
-
43
-
44
-
45
- rc = MsgBox("登録しますか？", vbYesNo + vbQuestion)
46
-
47
-
48
-
49
-
50
-
51
- If rc = vbYes Then
52
-
53
- MsgBox "登録しました", vbInformation
54
-
55
- Worksheets("sheet1").Cells(Name, 1).Value = Format(Now, "mm月dd日　hh時")
56
-
57
- Worksheets("sheet1").Cells(Name, 2).Value = UserForm1.Affiliation.Value
58
-
59
- Worksheets("sheet1").Cells(Name, 3).Value = UserForm1.NameBox.Value
60
-
61
- Worksheets("sheet1").Cells(Name, 4).Value = UserForm1.ContactTool.Value
62
-
63
- Worksheets("sheet1").Cells(Name, 5).Value = UserForm1.TextBox1.Value
64
-
65
- Affiliation.Value = ""
66
-
67
- NameBox.Value = ""
68
-
69
- ContactTool.Value = ""
70
-
71
- TextBox1.Value = ""
72
-
73
- Else
74
-
75
- MsgBox "処理を中止します", vbCritical
76
-
77
- End If
78
-
79
-
80
-
81
- End Sub
79
+ Dim Name As Long
80
+
81
+ Dim rc As VbMsgBoxResult
82
+
83
+
84
+
85
+ Name = 1
86
+
87
+
88
+
89
+ Do Until Cells(Name, 1) = ""
90
+
91
+ Name = Name + 1
92
+
93
+ Loop
94
+
95
+
96
+
97
+ rc = MsgBox("登録しますか？", vbYesNo + vbQuestion)
98
+
99
+
100
+
101
+
102
+
103
+ If rc = vbYes Then
104
+
105
+ MsgBox "登録しました", vbInformation
106
+
107
+ Worksheets("sheet1").Cells(Name, 1).Value = Format(Now, "mm月dd日　hh時")
108
+
109
+ Worksheets("sheet1").Cells(Name, 2).Value = UserForm1.Affiliation.Value
110
+
111
+ Worksheets("sheet1").Cells(Name, 3).Value = UserForm1.NameBox.Value
112
+
113
+ Worksheets("sheet1").Cells(Name, 4).Value = UserForm1.ContactTool.Value
114
+
115
+ Worksheets("sheet1").Cells(Name, 5).Value = UserForm1.TextBox1.Value
116
+
117
+ Affiliation.Value = ""
118
+
119
+ NameBox.Value = ""
120
+
121
+ ContactTool.Value = ""
122
+
123
+ TextBox1.Value = ""
124
+
125
+ Else
126
+
127
+ MsgBox "処理を中止します", vbCritical
128
+
129
+ End If
130
+
131
+
132
+
133
+ End Sub
134
+
135
+
136
+
137
+ '検索を実行します。部分一致検索を行っています。
138
+
139
+ 'Private Sub Search_Click()
140
+
141
+
142
+
143
+ 'If SearchBox.Value = "" Then
144
+
145
+ 'MsgBox "データがありません"
146
+
147
+ 'Else
148
+
149
+ 'Call UserForm1.Search_Click2
150
+
151
+ 'End If
152
+
153
+ 'End Sub
154
+
155
+
156
+
157
+ Sub Search_Click()
158
+
159
+
160
+
161
+ Dim lastRow As Long
162
+
163
+ Dim myData, myData2(), myno
164
+
165
+ Dim i As Long, j As Long, cn As Long
166
+
167
+
168
+
169
+ Workbooks("営業用メモV3.xlsm").Activate
170
+
171
+
172
+
173
+ '検索するデータを配列　myData　に格納しています。
174
+
175
+ With Worksheets("Sheet1")
176
+
177
+ lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
178
+
179
+ myData = .Range(.Cells(1, 1), .Cells(lastRow, 5)).Value
180
+
181
+ End With
182
+
183
+
184
+
185
+ '配列　myData の中で検索で一致したデータを配列　myData2　に格納しています。
186
+
187
+ ReDim myData2(1 To lastRow, 1 To 5)
188
+
189
+ For i = LBound(myData) To UBound(myData)
190
+
191
+ If myData(i, 2) Like "*" & SearchBox.Value & "*" And myData(i, 3) Like "*" & SearchBox2.Value & "*" Then
192
+
193
+ cn = cn + 1
194
+
195
+ myData2(cn, 1) = myData(i, 1)
196
+
197
+ myData2(cn, 2) = myData(i, 2)
198
+
199
+ myData2(cn, 3) = myData(i, 3)
200
+
201
+ myData2(cn, 4) = myData(i, 4)
202
+
203
+ myData2(cn, 5) = myData(i, 5)
204
+
205
+ End If
206
+
207
+ Next i
208
+
209
+
210
+
211
+ '検索で一致したデータをリストボックスに表示
212
+
213
+ With ListBox1
214
+
215
+ .ColumnCount = 5
216
+
217
+ .ColumnWidths = "88;40;55;60;50"
218
+
219
+ .List = myData2
220
+
221
+ End With
222
+
223
+
224
+
225
+ End Sub
226
+
227
+ 'リストボックスの詳細を表示
228
+
229
+ Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
230
+
231
+ With ListBox1
232
+
233
+ If .ListIndex = -1 Then
234
+
235
+ MsgBox "未選択です。"
236
+
237
+ Else
238
+
239
+ MsgBox .List(.ListIndex, 4), Title:="メモ詳細"
240
+
241
+ End If
242
+
243
+ End With
244
+
245
+ End Sub
246
+
247
+
248
+
249
+ Private Sub end_Button_Click()
250
+
251
+ Unload UserForm1
252
+
253
+ If (Workbooks.Count = 1) Then
254
+
255
+ ' 開いているブックが自身のみの場合はExcelを終了させる
256
+
257
+ ThisWorkbook.Save
258
+
259
+ Application.Quit
260
+
261
+ End If
262
+
263
+
264
+
265
+ ThisWorkbook.Save
266
+
267
+ Workbooks("営業用メモV3.xlsm").Close
268
+
269
+ End Sub
270
+
271
+
272
+
273
+ ![イメージ説明](bf4abc7958a45598669cd6569dfbd794.png)