Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : 指定なし)
数値によるリストボックスの指定
投稿日時: 20/12/24 15:35:24
投稿者: rodeo540
メールを送信

度々の連投すみません。
 
TextboxとListboxの2つが配置されているフォーム上で、
両方を連動させたいと思っています。
 
Listで指定したものをテキストに表示、
テキストに入力したものをListで表示(青でハイライト) です。
 
Listbox→TextboxはListboxのchangeイベントで出来るのですが、
Textbox→Listboxをする際にどのプロパティでListの選択ができるのか分かりません。
Listindexでは破線で選択できますが、青色のハイライトがついてきません。
また、Listで複数選択する際のプロパティはどのような形になるのでしょうか?
 
初歩的なことかもしれませんが、どなたがご教授お願いいたします。

回答
投稿日時: 20/12/24 17:48:56
投稿者: WinArrow
投稿者のウェブサイトに移動

Listbox、Textboxはどこのコントロールでしょうか?
 
下記のいづれでしょうか?
・フォームコントロール
・Activex
・Userform

回答
投稿日時: 20/12/24 17:54:22
投稿者: WinArrow
投稿者のウェブサイトに移動

>Textbox→Listboxをする際にどのプロパティでListの選択ができるのか分かりません。
 
TextboxのデータをListboxに反映する
ということならば、プロパティでにはそんな機能はりません。
 
Userformという前提で
Textboxの
AfterUpdateかExitイベントで
Listboxに書き込んでください。

投稿日時: 20/12/24 17:59:28
投稿者: rodeo540
メールを送信

ユーザーフォームになります。
 
>Listboxに書き込んでください。
ここのところがよく分かりません。
 
例えば、Textboxに2と入力すると、
ListboxのListindexの2が選択されるイメージとしたいですが、
破線での選択は反映されますが、青のハイライトになりません。
 
また、例えば、Textboxに2,3,4と複数入力すると、
Listboxの複数項目が選択されるようにしたいと思っています。
 
ご確認、よろしくお願いいたします。[/quote]

回答
投稿日時: 20/12/24 18:08:11
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:

例えば、Textboxに2と入力すると、
ListboxのListindexの2が選択されるイメージとしたいですが、

なぜ
Listboxを選択数必要があるのですか?
 
TextBox1からListBox1への転記方法
 

Private Sub TextBox1_AfterUpdate()
    Me.ListBox1.List(Me.ListBox1.ListIndex, 1) = Me.TextBox1.Text
End Sub

回答
投稿日時: 20/12/24 21:24:59
投稿者: WinArrow
投稿者のウェブサイトに移動

また、Listで複数選択する際のプロパティはどのような形になるのでしょうか
 
この話は、後回しにして
>Listindexでは破線で選択できますが、青色のハイライトがついてきません
を解決しましょう
そのために
>Listbox→TextboxはListboxのchangeイベントで出来るのですが
のコードを掲示してしてください。

回答
投稿日時: 20/12/24 23:31:19
投稿者: hatena
投稿者のウェブサイトに移動

引用:
テキストに入力したものをListで表示(青でハイライト) です。

 
ご希望のことは下記のようなことでしょうか。
 
Private Sub TextBox1_AfterUpdate()
    On Error Resume Next
    Me.ListBox1.Value = Me.TextBox1.Value
    If Err <> 0 Then Me.ListBox1.Value = ""
    On Error GoTo 0
End Sub

 
 
引用:
また、Listで複数選択する際のプロパティはどのような形になるのでしょうか?

 
MultiSelectプロパティに fmMultiSelectExtended か fmMultiSelectMulti を設定すればいいでしょう。
 

回答
投稿日時: 20/12/25 09:44:34
投稿者: WinArrow
投稿者のウェブサイトに移動

>Listindexでは破線で選択できますが、青色のハイライトがついてきません
 
この中の破線で選択できます
は、実際には、選択できていないと思います。
この状態では、Me.Listbox1.value を参照しても Nullになっています。
エラータラップして、Value にどのような値を代入しても無意味です。
 
そのような意味で、Chanegeイベントのコードがどのようになっているか
確認する必要があります。
 
また、Listbox の複数選択については、
同時に選択できることはなく、選択した順番にChangeイベントが発生します。
受け取るテキストボックスとの対応も考慮しておかないと、データをListboxに戻せなくなります。
 

投稿日時: 20/12/25 10:41:34
投稿者: rodeo540
メールを送信

皆様、色々ありがとうございます。
今日は都合上コードの転記が出来ませんので、
来週の月曜日以降にお返事いたいます。
 
申し訳有りませんが、宜しくお願いいたします。

投稿日時: 20/12/27 13:50:41
投稿者: rodeo540
メールを送信

お返事遅くなりました。
コードは以下の感じです。
 
⇒リストボックスのChangeはテキストボックスにうまく反映されます。
------------------------------------------------------
Private Sub ListBox1_Change()
 
If T = 1 Then
 Textchange = False
 If Listchange = True Then
  s = ""
  For i = 0 To ListBox1.ListCount - 1
   If ListBox1.Selected(i) = True Then
    If s = "" Then
     s = ListBox1.List(i)
    Else
     s = s & "," & ListBox1.List(i)
    End If
    TextBox1.Text = s
   End If
  Next i
 End If
End If
Textchange = True
T = 1
 
End Sub
------------------------------------------------------
⇒テキストボックスのChangeをリストボックスに反映できません。
------------------------------------------------------
Private Sub TextBox1_Change()
 
If T = 1 Then
 Listchange = False
 If Textchange = True Then
 
★★★★↓ここでリストボックスに反映させたいです↓★★★★★★★★
 'ListBox1.Value = 2
 'ListBox1.ListIndex = 4
 'ListBox1.SetFocus
★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
  
 End If
End If
Listchange = True
T = 1
 
End Sub
------------------------------------------------------
⇒以下、直接関係は有りませんが念のため添付します。
------------------------------------------------------
Private Sub UserForm_Activate()
  
 T = 0
 Textchange = True
 Listchange = True
  
 TextBox1.Value = tempnumF
 TextBox1.SetFocus
 TextBox1.SelStart = 0
 TextBox1.SelLength = Len(TextBox1.Text)
 
 ListBox1.ColumnCount = 2
 ListBox1.ColumnWidths = "20;120"
 With ListBox1
 For k = 1 To Fn
 ListBox1.AddItem ""
  .List(.ListCount - 1, 0) = k
  .List(.ListCount - 1, 1) = figlevl(k)
 Next k
 End With
 ListBox1.ListIndex = tempnumF - 1
 
End Sub

投稿日時: 20/12/27 13:57:55
投稿者: rodeo540
メールを送信

WinArrow さんの引用:
>Listindexでは破線で選択できますが、青色のハイライトがついてきません
 
この中の破線で選択できます
は、実際には、選択できていないと思います。
この状態では、Me.Listbox1.value を参照しても Nullになっています。
エラータラップして、Value にどのような値を代入しても無意味です。
 
そのような意味で、Chanegeイベントのコードがどのようになっているか
確認する必要があります。
 
また、Listbox の複数選択については、
同時に選択できることはなく、選択した順番にChangeイベントが発生します。
受け取るテキストボックスとの対応も考慮しておかないと、データをListboxに戻せなくなります。
 

 
それぞれのChangeイベントに対応するように、
フラグを立てて片方のboxが変わっているときは
一方はChangeに反応しないようにしているつもりです。。。
 
ご確認よろしくお願いいたします。

投稿日時: 20/12/27 13:59:54
投稿者: rodeo540
メールを送信

hatena さんの引用:
引用:
テキストに入力したものをListで表示(青でハイライト) です。

 
ご希望のことは下記のようなことでしょうか。
 
Private Sub TextBox1_AfterUpdate()
    On Error Resume Next
    Me.ListBox1.Value = Me.TextBox1.Value
    If Err <> 0 Then Me.ListBox1.Value = ""
    On Error GoTo 0
End Sub

 
 
引用:
また、Listで複数選択する際のプロパティはどのような形になるのでしょうか?

 
MultiSelectプロパティに fmMultiSelectExtended か fmMultiSelectMulti を設定すればいいでしょう。
 

 
WinArrowさんの通り、LisBoxのvalueはNullとなってしまいます。
また、当然 fmMultiSelectExtended か fmMultiSelectMulti を指定した状態で、
テキストボックスの数字をListBoxに反映させるイメージです。

回答
投稿日時: 20/12/27 15:23:49
投稿者: WinArrow
投稿者のウェブサイトに移動

>⇒リストボックスのChangeはテキストボックスにうまく反映されます。
  
Changeイベントのコードを拝見
Changeイベントは、選択する都度発生します。
現段階は、複数選択が設定されていないので、総なめしたところで1件しか操作していませんが、
Listboxの中を総なめするような処理には向いていません。
この処理をコマンドボタンに移動してみては、いかがでしょう?
つまり、Listboxを選択(複数)し終わったら、コマンドボタンでTextBoxへ転送。
  
TextBoxのChangeイベントは、1文字入力毎に発生します。
 同様に、コマンドボタンで対応したほうがよいでしょう。
  
もう一つは、Listboxの行番号をどこかに持っていなくてもよいのかな?
 
※コードをみても、何をしようとしているか理解に苦しみます。

回答
投稿日時: 20/12/27 15:35:11
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
それぞれのChangeイベントに対応するように、
フラグを立てて片方のboxが変わっているときは
一方はChangeに反応しないようにしているつもりです。。。
  
ご確認よろしくお願いいたします。

 
このフラグが、余計に難しくしている。
フラグを使う意味はないと思いますが、
そもそも、複数選択を使おうとするならば、Changeイベントは不適当・・・一利もなし。

投稿日時: 20/12/27 15:45:02
投稿者: rodeo540
メールを送信

WinArrow さんの引用:
>⇒リストボックスのChangeはテキストボックスにうまく反映されます。
  
Changeイベントのコードを拝見
Changeイベントは、選択する都度発生します。
現段階は、複数選択が設定されていないので、総なめしたところで1件しか操作していませんが、
Listboxの中を総なめするような処理には向いていません。
この処理をコマンドボタンに移動してみては、いかがでしょう?
つまり、Listboxを選択(複数)し終わったら、コマンドボタンでTextBoxへ転送。
  
TextBoxのChangeイベントは、1文字入力毎に発生します。
 同様に、コマンドボタンで対応したほうがよいでしょう。
  
もう一つは、Listboxの行番号をどこかに持っていなくてもよいのかな?
 
※コードをみても、何をしようとしているか理解に苦しみます。

 
ListBoxはfor〜Nextの所で回してますので、
複数選択した場合でもは、そのListIndexがそのままTextBoxに反映されます。
その時にTextChangeのフラグがFalseなのでTextBoxが変更になってもそのChangeイベントは発生しないです。
 
コマンドボタンに渡せばいいのですが、選択したリアルタイムでテキストボックスと
リストボックスを同期させたいですが、いい方法は無いでしょうか。。。
ListIndexのNullの問題(青のハイライトを伴わせて実際に選択状態にしたい)も
まだ解決できていないです。。

投稿日時: 20/12/27 15:51:27
投稿者: rodeo540
メールを送信

あと、コード中ではないですが、もちろん fmMultiSelectExtended
は初期の時点で設定しています。
フラグをどうするか、どのイベントが最適かもう一度考えてみます。
コマンドボックスを使うことなく、
両方を完全に同じタイミングで同期させようとすると、
他に良いイベントはありますか??

回答
投稿日時: 20/12/27 16:19:06
投稿者: hatena
投稿者のウェブサイトに移動

前回の解答は、複数選択不可のリストボックスという前提です。
質問にそのような説明はなかったので。
  
  
さて、後から追記されたコードを見ると、
  
リストボックスは2例表示
1列目は1からの連番(行番号)、2列目は自作関数から取得したデータ
テキストボックスには、選択された行番号がカンマ区切りで格納される。
  
ということのようですね。
だとすると、下記のようなコードでいけます(サンプルで動作確認済み)。
  

Option Explicit

Dim ListChanging As Boolean
Dim TextChanging As Boolean

Private Sub ListBox1_Change()
    If TextChanging Then Exit Sub 'テキスト変更中は抜ける
    ListChanging = True
    
    Dim s As String, i As Long
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            s = s & "," & ListBox1.List(i, 0)
        End If
    Next i
    TextBox1.Value = Mid(s, 2)
    
    ListChanging = False
End Sub

Private Sub TextBox1_Change()
    If ListChanging Then Exit Sub    'リスト変更中は抜ける
    TextChanging = True

    Dim i As Long
    For i = 0 To ListBox1.ListCount - 1
        ListBox1.Selected(i) = False
    Next i
    
    On Error Resume Next
    Dim s As Variant
    For Each s In Split(TextBox1.Value, ",")
        ListBox1.Selected(CLng(s) - 1) = True
    Next

    TextChanging = False
End Sub

回答
投稿日時: 20/12/27 16:31:21
投稿者: WinArrow
投稿者のウェブサイトに移動

Listbox1_changeイベントをテストしても、
破線状態を再現できません。
 
Listboxで複数選択を設定してある場合、
Listbox1.Value は使えません。
Listbox1.Valueには、1つの値しか入らない。
 
TextBox1_Changeイベントは、手入力(修正)時にイベントが発生するから
使わない方がよいといっているんです。
 
 

回答
投稿日時: 20/12/27 16:40:27
投稿者: WinArrow
投稿者のウェブサイトに移動

Textbox→Listbox転送の件
 
Textboxには、Listoxの1列目の数値が「,」で区切って入っています。
TextBoxの値をListboxのどの行のどの列に転送するのですか?
Listboxの行の求め方は、どのように考えていますか?
 
Listbox1の1列目の数値は、何を意味しているのでしょうか?
どこかを参照してセットしていますが、参照元に戻すのでしょうか?
 
 

回答
投稿日時: 20/12/27 17:07:02
投稿者: hatena
投稿者のウェブサイトに移動

とりあえず、
上の私の回答のコードの簡単な解説。
 
複数選択可のリストボックスで選択(青ハイライト)するのは
 

 ListBox1.Selected(インデックス) = True

です。
 
Changeイベントは、フラグを立てて、イベントが連鎖しないように管理すれば、問題なく使えると思います。
(作成したサンプルではテキストボックスの入力に対してリアルタイムに反映されてます。)
 
テキストボックスに数値以外や行番号の範囲以外の数値が入力された場合エラーになるので、対策が必要ですが、
On Error Resume Next で無視するというお手軽の方法をとりました。
 
提示されたコードでは1列目には行番号が格納されているようなので、その前提のコードです。
 
もし、行番号意外のデータが格納されているなら、一致する行を検索するという処理に変更する必要があります。

回答
投稿日時: 20/12/27 17:12:52
投稿者: WinArrow
投稿者のウェブサイトに移動

 hatena さんのレスをみて
なんとなくですが、Textboxの用途わかってきた感じ・・・・
 
Listboxで選択した行を記憶するためのTextboxのような気がします。
そもそも、手操作でTextboxを変更するのですか?
Textboxを変更して、それをListboxに反映する・・・ことを考えているの?

回答
投稿日時: 20/12/27 18:25:24
投稿者: WinArrow
投稿者のウェブサイトに移動

>Listindexでは破線で選択できますが
 
ようやく、この現象が再現できました。
 
どこかで、Selected(x) = Falseをしているものと考えていましたが、
違っていましたね・・・
 
Listboxが複数選択設定されている状態で
ListIndex に「値」をセットすると
この現象が発生しました。
 
Listboxは複数選択設定されていなければ、
選択状態になります。
 
最初に、複数選択設定してあることを、説明していたら、
再現テストでいたかもしれません。
 
 
 
 

投稿日時: 20/12/28 06:19:37
投稿者: rodeo540
メールを送信

皆様、色々とありがとうございます。
頂いた意見で動作を確認後に、再度ご連絡いたします。
よろしくお願いいたします。

投稿日時: 20/12/28 07:28:08
投稿者: rodeo540
メールを送信

皆様、アドバイスありがとうございました。
無事にやりたかったことが解決できました。
文章だけですとなかなか伝えきれなくて申し訳ありませんでした。
 
繰り返しになってしまいますが、例えば、
 
TextBoxに1,2,3と手入力すると、
Listboxの1番目、2番目、3番目が選択される、
Listboxの1番目、2番目、3番目を選択すると、
TextBoxに1,2,3と入力される
 
イメージです。
 
実は、Excelのトピックに上げていますが、
実際はWordのVBAで図の相互参照を簡略化するマクロを組んでいました。
 
不要かと思いますが完成後のコードを転記します。
洗練されていない箇所も多々あると思いますがお許しください。
(すみません、フラグの所、頂いたものに直してないです。。。)
 
★------------------モジュール側------------------
Public modeF As Boolean
Public figlevl(999) As Variant
Public Fn As Variant
Public tempnumF As Variant
Public figurenum As String '図番号
Sub 図番の相互参照()
  
Dim Arrfigurenum As Variant
  
On Error GoTo 図番の相互参照_Error
  
Application.ScreenUpdating = False
ActiveDocument.Fields.Update
 
St = Selection.Start
Ed = Selection.End
  
ActiveWindow.View.ShowFieldCodes = True
 
Dim myRange As Range
Set myRange = Selection.Range
  
With myRange.Find
 .Text = "SEQ 図"
 .Forward = False
 .Wrap = wdFindStop
' .Format = False
' .MatchCase = False '大文字と小文字の区別する
' .MatchWholeWord = False '完全に一致する単語だけを検索する
' .MatchAllWordForms = False '英単語の異なる活用形を検索する
' .MatchSoundsLike = False 'あいまい検索(英)
' .MatchFuzzy = False 'あいまい検索(日)
' .MatchByte = False '半角と全角を区別する
' .MatchWildcards = True 'ワイルドカードを使用する
 c = 0
 Do While .Execute
  c = c + 1
 Loop
 tempnumF = c + 1
End With
 
ActiveDocument.Range(St, Ed).Select
Set myRange = Selection.Range
 
With myRange.Find
 .Text = "SEQ 図"
 .Forward = True
 .Wrap = wdFindStop
' .Format = False
' .MatchCase = False '大文字と小文字の区別する
' .MatchWholeWord = False '完全に一致する単語だけを検索する
' .MatchAllWordForms = False '英単語の異なる活用形を検索する
' .MatchSoundsLike = False 'あいまい検索(英)
' .MatchFuzzy = False 'あいまい検索(日)
' .MatchByte = False '半角と全角を区別する
' .MatchWildcards = True 'ワイルドカードを使用する
 cc = 0
  
 Do While .Execute
  cc = cc + 1
  Exit Do
 Loop
 
End With
 
If cc = 0 Then tempnumF = c
If c = 0 And cc = 0 Then tempnumF = ""
 
ActiveWindow.View.ShowFieldCodes = False
Set myRange = Nothing
  
'----図目次を挿入しリストを作成-----
ActiveDocument.Range(0, 0).Select
Selection.TypeParagraph
Selection.MoveLeft Unit:=wdCharacter, Count:=1
 
With ActiveDocument
 .TablesOfFigures.Add Range:=Selection.Range, Caption:="図", _
   IncludeLabel:=True, RightAlignPageNumbers:=True, UseHeadingStyles:=False, _
   UpperHeadingLevel:=1, LowerHeadingLevel:=3, IncludePageNumbers:=False, _
   AddedStyles:="", UseHyperlinks:=True, HidePageNumbersInWeb:=True
 
 ActiveDocument.Range(0, 0).Select
 
 Fn = 0
 For Each par In ActiveDocument.Paragraphs
  With par
   If .Range.Text = vbCr Then
    GoTo line9
   ElseIf .Range.Text <> "" Then
    Fn = Fn + 1
    figlevl(Fn) = Replace(.Range.Text, vbCr, "")
   End If
  End With
 Next par
 
line9:
  .TablesOfFigures(1).Delete
End With
Selection.Delete Unit:=wdCharacter, Count:=1
'-----------------------------------
  
ActiveDocument.Range(St, Ed).Select
 
'以下が無いと表示がなぜかずれる
Selection.TypeText "0"
Selection.TypeBackspace
 
Application.ScreenUpdating = True
'----------------------------------------
'●フォームshowとモードレスの一時停止処理
modeF = False
相互参照_図フォーム.Show vbModeless
'----------------------------------------
 Do
   DoEvents 'フォーム側にtrueのスイッチ
 Loop Until modeF
'----------------------------------------
  
'数字のみに分解
Dim buf As String, RE, reMatch, reValue
Set RE = CreateObject("VBScript.RegExp")
     
Dim Num(999) As Integer
     
buf = figurenum
With RE
.Pattern = "\d+"
.Global = True
Set reMatch = .Execute(buf)
 If reMatch.Count > 0 Then
  T = 0
  For Each reValue In reMatch
   T = T + 1
   Num(T) = reValue
  Next reValue
 End If
End With
Set RE = Nothing
 
For i = 1 To T
 Selection.InsertCrossReference ReferenceType:="図", _
 ReferenceKind:=wdOnlyLabelAndNumber, _
 ReferenceItem:=CInt(Num(i))
 
 If i <> T Then Selection.TypeText "、"
 
図番の相互参照_Error:
Next
  
Unload 相互参照_図フォーム
  
End Sub
 
★------------------フォーム側------------------
Option Base 1
Dim Textchange As Variant
Dim Listchange As Variant
Dim T As Variant
Private Sub ListBox1_Change()
 
If T = 1 Then
 Textchange = False
 If Listchange = True Then
  s = ""
  For i = 0 To ListBox1.ListCount - 1
   If ListBox1.Selected(i) = True Then
    If s = "" Then
     s = ListBox1.List(i)
    Else
     s = s & "," & ListBox1.List(i)
    End If
    TextBox1.Text = s
   End If
  Next i
 End If
End If
Textchange = True
T = 1
 
End Sub
Private Sub TextBox1_Change()
 
If T = 1 Then
 Listchange = False
 If Textchange = True Then
 
 For i = 0 To ListBox1.ListCount - 1 '選択状態を初期化
  ListBox1.Selected(i) = False
 Next i
 
 '--数字のみに分解--
  Dim buf As String, RE, reMatch, reValue
  Set RE = CreateObject("VBScript.RegExp")
     
  Dim Num(999) As Integer
     
  buf = TextBox1.Value
  With RE
  .Pattern = "\d+"
  .Global = True
  Set reMatch = .Execute(buf)
   If reMatch.Count > 0 Then
    T = 0
    For Each reValue In reMatch
     T = T + 1
     Num(T) = reValue
    Next reValue
   End If
  End With
  Set RE = Nothing
 '------------------
   
  On Error Resume Next '数字以外となった場合
  For i = 1 To T
   ListBox1.Selected(CLng(Num(i)) - 1) = True
  Next i
  
 End If
End If
Listchange = True
T = 1
 
End Sub
Private Sub UserForm_Activate()
  
 T = 0
 Textchange = True
 Listchange = True
  
 TextBox1.Value = tempnumF
 TextBox1.SetFocus
 TextBox1.SelStart = 0
 TextBox1.SelLength = Len(TextBox1.Text)
 
 ListBox1.ColumnCount = 2
 ListBox1.ColumnWidths = "20;120"
 With ListBox1
 For k = 1 To Fn
 ListBox1.AddItem ""
  .List(.ListCount - 1, 0) = k
  .List(.ListCount - 1, 1) = figlevl(k)
 Next k
 End With
 ListBox1.ListIndex = tempnumF - 1
 
End Sub
Private Sub CommandButton1_Click()
 
figurenum = TextBox1.Value
 
相互参照_図フォーム.hide
modeF = True
 
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 Unload Me
 figurenum = ""
 modeF = True
End Sub
Private Sub CommandButton2_Click()
 Unload Me
 figurenum = ""
 modeF = True
End Sub