Access (VBA)

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

 
(指定なし : 指定なし)
「テキストボックス内で改行する」について
投稿日時: 24/06/19 22:28:12
投稿者: hatena
投稿者のウェブサイトに移動

Excel VBA を学ぶなら moug モーグ|Access (VBA)|テキストボックス内で改行する
https://www.moug.net/faq/viewtopic.php?t=82797
 
解決済みですが、すこし私のアイデアを置いておきます。
 
テキストボックスのカーソル位置(SelStart)にテキストを挿入する。
テキストはリストボックスのダブルクリックで選択されたテキスト。
という質問です。
 
これで問題になるのは、リストボックスのダブルクリックしたときには、
既にリストボックスにフォーカスが移動しているので、テキストボックスのSelStartは使えない。
 
ですので、フォーカス移動前に正確なSelStart, SelLengthを正確に取得しておく必要があります。
これについては、skさんの回答で詳しく説明されていて、対処コードも提示されてます。
 
この、skさんの回答、さすがだと思いました。
 
参考までに、別案として私ならこうするというものを置いておきます。
 
今回の問題点はリストボックスのダブルクリックではフォーカス移動してしまうために複雑な対処法が必要になります。フォーカス移動せずに実行できればコードはシンプルになります。
 
選択するリストの件数がスクロールさせるほど多くないのなら、ラベルのリスト件数分配置しておいて、そのクリック時(あるいはダブルクリック時)で実行するようにします。
例えば件数が10件なら、ラベルを10個配置して名まえを、lbl1, lbl2, ・・・・lbl10 とします。
標題に挿入したいテキストを設定しておきます。
フォームモジュールに下記のように記述します。
 

Option Compare Database
Option Explicit

Private Sub Form_Load()
    Dim i As Long
    For i = 1 To 3
        Me.Controls("lbl" & i).OnDblClick = "=InsertText([lbl" & i & "])"
    Next
End Sub

Private Function InsertText(lbl As Access.Label)
    If Me.ActiveControl.Name <> "テキスト1" Then Exit Function
    With Me.テキスト1
        .SelText = lbl.Caption
        .Value = .Value & vbCrLf
        .SelStart = Len(.Value)
    End With
End Function

 
ちなみに前回の私の回答で改行の挿入がうまくいかずに SendKeys "^{ENTER}" を使わなければいけなかった原因は、.Textに代入しているのが原因でした。これを .Value に変更したら vbCrLf でうまく挿入できました。
 

投稿日時: 24/06/19 22:52:56
投稿者: hatena
投稿者のウェブサイトに移動

リスト件数が多くてスクロールする必要があるのなら、別フォームにリストボックスを配置して、別フォームは「ポップアップ」を「はい」にしておきます。そのリストボックスのダブルクリックで挿入を実行すればいいでしょう。
別フォームなら、元フォームのテキストボックスはアクティブなままですので、SelStart やSelTextは使えますのでやはりコードはシンプルになります。
 
ポップアップフォーム上のリストボックスのダブルクリック時のコードは下記になります。
 

Private Sub リスト0_DblClick(Cancel As Integer)
    With Forms!フォーム1!テキスト1
        .SelText = Me.リスト0,Value
        .Value = .Value & vbCrLf
        .SelStart = Len(.Value)
    End With
End Sub

 
元フォームの読み込み時のコード
Private Sub Form_Load()
    DoCmd.OpenForm "ポップアップフォーム"
    Forms!ポップアップフォーム.Move 100, 100 '表示させたい位置に移動
End Sub

 
ポップアップフォームでは見た目がという場合は使えませんが。

投稿日時: 24/06/20 16:54:12
投稿者: hatena
投稿者のウェブサイトに移動

閉じます。