質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.05%

VBA リストボックスの表示について

解決済

回答 3

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 1,035

score 1

ユーザーホーム上でリストボックスの中に表示される文字数を制限したいです

エクセル/VBAでユーザーホームを使った検索機能をつくり
検索した結果をリストボックスに表示して選択すると詳細が出る
というものを作成したのですが文字数が多いものは枠から
はみ出る形で見栄えが悪いので表示するときのみ文字数を制限したいのでしょうか?
出来るのであれば下記の画像のようにしてみたいと思ってます。

ソースコードはネットのサンプルを少し治したものになります

該当のソースコード!

Option Explicit
'連絡ツールのリストボックス
Private Sub UserForm_Initialize()
With ContactTool
.AddItem "電話"
.AddItem "Cメール"
.AddItem "社内メール"
.AddItem "Line"
.AddItem "Slack"
.AddItem "その他"
End With

End Sub

'登録確認
Private Sub Registration_Click()

If UserForm1.NameBox.Value = "" Or UserForm1.TextBox1.Value = "" Then
MsgBox "未入力があります"
Else
Call UserForm1.Registration_Click2

End If

End Sub
'エクセルに登録
Sub Registration_Click2()
Dim Name As Long
Dim rc As VbMsgBoxResult

Name = 1

Do Until Cells(Name, 1) = ""
Name = Name + 1
Loop

rc = MsgBox("登録しますか?", vbYesNo + vbQuestion)


If rc = vbYes Then
MsgBox "登録しました", vbInformation
Worksheets("sheet1").Cells(Name, 1).Value = Format(Now, "mm月dd日 hh時")
Worksheets("sheet1").Cells(Name, 2).Value = UserForm1.Affiliation.Value
Worksheets("sheet1").Cells(Name, 3).Value = UserForm1.NameBox.Value
Worksheets("sheet1").Cells(Name, 4).Value = UserForm1.ContactTool.Value
Worksheets("sheet1").Cells(Name, 5).Value = UserForm1.TextBox1.Value
Affiliation.Value = ""
NameBox.Value = ""
ContactTool.Value = ""
TextBox1.Value = ""
Else
MsgBox "処理を中止します", vbCritical
End If

End Sub

'検索を実行します。部分一致検索を行っています。
'Private Sub Search_Click()

'If SearchBox.Value = "" Then
'MsgBox "データがありません"
'Else
'Call UserForm1.Search_Click2
'End If
'End Sub

Sub Search_Click()

Dim lastRow As Long
Dim myData, myData2(), myno
Dim i As Long, j As Long, cn As Long

Workbooks("営業用メモV3.xlsm").Activate

'検索するデータを配列 myData に格納しています。
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
myData = .Range(.Cells(1, 1), .Cells(lastRow, 5)).Value
End With

'配列 myData の中で検索で一致したデータを配列 myData2 に格納しています。
ReDim myData2(1 To lastRow, 1 To 5)
For i = LBound(myData) To UBound(myData)
If myData(i, 2) Like "*" & SearchBox.Value & "*" And myData(i, 3) Like "*" & SearchBox2.Value & "*" Then
cn = cn + 1
myData2(cn, 1) = myData(i, 1)
myData2(cn, 2) = myData(i, 2)
myData2(cn, 3) = myData(i, 3)
myData2(cn, 4) = myData(i, 4)
myData2(cn, 5) = myData(i, 5)
End If
Next i

'検索で一致したデータをリストボックスに表示
With ListBox1
.ColumnCount = 5
.ColumnWidths = "88;40;55;60;50"
.List = myData2
End With

End Sub
'リストボックスの詳細を表示
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
With ListBox1
If .ListIndex = -1 Then
MsgBox "未選択です。"
Else
MsgBox .List(.ListIndex, 4), Title:="メモ詳細"
End If
End With
End Sub

Private Sub end_Button_Click()
Unload UserForm1
If (Workbooks.Count = 1) Then
' 開いているブックが自身のみの場合はExcelを終了させる
ThisWorkbook.Save
Application.Quit
End If

ThisWorkbook.Save
Workbooks("営業用メモV3.xlsm").Close
End Sub


イメージ説明

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • kano_036

    2020/06/16 10:37

    ttyp03様
    かしこまりました。

    キャンセル

  • ttyp03

    2020/06/16 10:55

    何度も申し訳ないですが、コードはコードタグで括ってください。

    キャンセル

  • ttyp03

    2020/06/16 11:06

    ああああああ、のところを見映え良くしたいということですよね?
    2行目のような感じでいいんですかね?途中でカットして...を付ける。

    どうでもいいですけど、背景がすごいw

    キャンセル

回答 3

checkベストアンサー

0

先走って回答しておきます。
見た目12文字より長い場合カットすればよいかと思うので、myData2(cn, 5)への代入処理を次のようにしてみてはいかがでしょうか。

If Len(myData(i, 5)) > 12 Then
    myData2(cn, 5) = Left(myData(i, 5), 12) & "..."
Else
    myData2(cn, 5) = myData(i, 5)
End If

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2020/06/16 12:14

    ttyp03様のコードに書き換えたら思い通りの状態になりました
    ありがとうございます!!

    キャンセル

0

UserForm1.TextBox1への入力時に文字数制限するのであればこんな感じです。

'
'(Test_Sample_Miniature)
'
Private strWork As String

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    If Len(Me.TextBox1.Text) > 5 Then
        MsgBox "入力文字は5文字以内"
        Me.TextBox1.Text = strWork
        Cancel = True
    End If
End Sub

Private Sub TextBox1_Enter()
    strWork = Me.TextBox1.Text
End Sub

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

記入ミスです。削除します。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.05%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る