[[20111108124847]]　『テキストボックス内の自動改行』（たち) 　ページの最後に飛ぶ

『テキストボックス内の自動改行』（たち)

 ｴｸｾﾙVBAです。
 UserFormのテキストボックスに300文字を入力するとき、1行を30文字で制限して自動で改行することは出来ますか？
 理由はテキストボックスの値がセルに入った時に印刷範囲から飛び出てしまうのを防ぐ為です。
 よろしくおねがいします。

 文字といっても全角だとか半角によって幅は異なるんだけど、とにかく「３０文字」ということなら。

 まず、プロパティでMultiLineをTrueにしておいて

 Private Sub TextBox1_Change()
    Dim n As Long

    With TextBox1
        If .Tag = "X" Then Exit Sub
        .Tag = "X"
        n = Len(Replace(.Text, vbCrLf, ""))
        If n = 0 Then
            .Text = Empty
        Else
            If n Mod 30 = 0 Then .Text = .Text & vbCrLf
        End If
        .Tag = ""
    End With
 End Sub

 (ぶらっと)

 再投稿

 操作者が最後の行でバックスペースキーなんかで行の先頭に戻ったりすると
上記ではちょっと不安定な動きになるかも。（最後に改行が２つついてしまう）
あるいは、入力後、真ん中の行あたりで入力操作で改行させたあと、最後の行以下に追加入力すると、
ちょっと最後のほうの改行が３０文字にはならない可能性もあるねぇ。

 操作者の入力操作による改行を「無効」にしていいなら、以下のほうが安定しているかな。

 Option Explicit

 Private Sub TextBox1_Change()
    Dim n As Long
    Dim s As String
    Dim x As Long

    With TextBox1
        If .Tag = "X" Then Exit Sub
        .Tag = "X"
        s = Replace(.Text, vbCrLf, "")
        n = Len(s)
        If n = 0 Then
            .Text = Empty
        Else
            .Text = Empty
            For x = 1 To n Step 30
                If x > 1 Then .Text = .Text & vbCrLf
                .Text = .Text & Mid(s, x, 30)
            Next
        End If
        .Tag = ""
    End With
 End Sub

 (ぶらっと)

できました。ありがとうございます。

全角と半角両方使うのですが、同じ長さになるようにできますか？
手打ちの改行は必要なので…ごめんなさい。

 そもそも、文字の幅ってフォントでまちまちだし、同じフォントでも、たとえば半角小文字で
aaaaa といれるのと jjjjj といれるのでは、同じ半角文字数でも実際の幅はずいぶん違うよね。
まぁ、それでも割り切りで半角ベースで30文字（それとも60文字かな？）としよう。
でも・・・・
アップしたコードは１文字入力された時点で判定して必要なら改行を挿入しているんだけど、
「手打ちの改行は必要なので」となると、う～ん。
マクロで挿入した改行なのか操作者が打ち込んだものなのかがわからない。

 たとえば1文字毎には何もせず入力者の入力に任せて（途中で改行したければして）
最後に、このテキストボックスを抜ける段階で、一括して、入力者が改行したところは尊重して
それ以外のところを３０（あるいは６０？）文字毎に区切るのは、できないこともないけど。

 追記）あっ、今、ひらめいた！1文字毎にもできるかもしれない。
　　　　（でも、勘違いかもしれないけど）

 (ぶらっと)

 簡単な確認しかしてない。
半角３０文字にしてある。６０文字なら★印のところを修正。
（21:38 一カ所修正）
（22:38 また一カ所修正）

 Private Sub TextBox1_Change()
    Dim s As Variant
    Dim v As Variant
    Dim x As Long
    Dim n As Long
    Dim d As String
    Dim t As String
    Dim k As Long

    With TextBox1
        If .Tag = "X" Then Exit Sub
        .Tag = "X"
        v = Split(.Text, vbCrLf)
        For Each s In v
            If Len(s) > 0 Then
                n = 0
                t = ""
                For x = 1 To Len(s)
                    d = Mid(s, x, 1)
                    If d = vbCrLf Then
                        n = 0
                    Else
                        n = n + LenB(StrConv(d, vbFromUnicode))
                        If n > 30 Then    '★
                            t = t & vbCrLf
                            n = LenB(StrConv(d, vbFromUnicode))
                        End If
                    End If
                    t = t & d
                Next
                v(k) = t
            End If
            k = k + 1
        Next
        .Text = Join(v, vbCrLf)
        .Tag = ""
    End With
 End Sub

 (ぶらっと)

 >理由はテキストボックスの値がセルに入った時に印刷範囲から飛び出てしまうのを防ぐ為です。

 これが理由なら、シートの対象セルに位置･サイズを合わせたActiveXControlの
 テキストボックス（または、ラベル）を配置して、それにデータを代入する仕様では？

 未検証ですが、試してみてください。

 ichinose

ぶらっとさん

 すでに入力されているテキストボックスで1行目を編集してるときに、ｴﾝﾀｰ押すと一番下の行まで飛んじゃいます…。

いちのせさん

 全く初耳です。どういう感じのものですか？

 セルの書式設定で折り返して表示にしては？

名無しさん

 その方法ができるならやってるんですが…セルが結合出来ない状況なので厳しいです。

 >すでに入力されているテキストボックスで1行目を編集してるときに、ｴﾝﾀｰ押すと一番下の行まで飛んじゃいます…。

 あぁ、とぶねぇ。普通はとばないけど、全角入力がおわって最後にエンターした結果、その行の桁が制限文字を超えた場合にそうなるんだね。

 う～ん・・・どうするんだろ？ひらめかないなぁ。
もし、テキストボックス上は、どうでもいい、セルに落とし込んだ時にセル側に対して処理を行えばいいのなら
皆さんがいってるように、エクセルの機能を使って対処するほうがいいのかも。
（テキストボックスは、自動改行なしで）

 で、それをＶＢＡ側で行うってことなら、できるかなぁ。それでいい？
もし、それでいいとして、現在は、このテキストボックスの値をControlSourceでセルに紐つけてる？
それとも、別のトリガー（コマンドボタン等）で、セルに書き込んでいる？

 とりあえず、ControlSourceで紐つけているとすれば、アップしたコードを、ほとんどそのままで
以下のようにちょっとだけなおしてイベントをかえればすれば、なんとかなるかな？
（でも、また、どこかで不具合が出るかもね）

 Private Sub TextBox1_AfterUpdate()
    Dim s As Variant
    Dim v As Variant
    Dim x As Long
    Dim n As Long
    Dim d As String
    Dim t As String
    Dim k As Long

    With TextBox1
        v = Split(.Text, vbCrLf)
        For Each s In v
            If Len(s) > 0 Then
                n = 0
                t = ""
                For x = 1 To Len(s)
                    d = Mid(s, x, 1)
                    If d = vbCrLf Then
                        n = 0
                    Else
                        n = n + LenB(StrConv(d, vbFromUnicode))
                        If n > 30 Then    '★
                            t = t & vbCrLf
                            n = LenB(StrConv(d, vbFromUnicode))
                        End If
                    End If
                    t = t & d
                Next
                v(k) = t
            End If
            k = k + 1
        Next
        .Text = Join(v, vbCrLf)
    End With

 End Sub

 (ぶらっと)

ぶらっとさん

 問題なく動きます。
 でも、やっぱり半角全角文字によってかなり差がでますね。
 ichinoseさんの方法も興味あるんですが、全く理解できず…。
 セルの端まで行ったら改行するなんてことが出来たら最高なんですけど、改行した先は次のセルなんでね。折り返すとはまた違うんです。

 >セルの端まで行ったら改行するなんてことが出来たら最高なんですけど、改行した先は次のセルなんでね。

 半角文字だけが30文字以上続かない条件であれば

  Private Sub CommandButton1_Click()
  With Range("A1")
    .Value = Me.TextBox1.Value
    .Justify
  End With
  End Sub

 こんなのでA1セルからセルに入る分づつ下へ転記できますけど
 （ｍｏｍｏ）

 >ichinoseさんの方法も興味あるんですが、全く理解できず…。

 私がでしゃばるのもいかがなものかとは思うし、またichinoseさんの指摘ポイントは違うことかもしれないけど、きっと。

 ・新規ブックのシートにコントロールツールボックスからLABELを選んでシートに１つ配置してみて。
 ・で、そのラベルをB2:D7の範囲ピッタリに配置。これは手作業でもできるけど、とりあえず、以下のコードでやる。
 ・で、そこに、任意の改行も含んだ文字列を、どさっと放り込む。
 ・そうすると、シート上のラベルには、おそらく(たち)さんが望むようなイメージで文字列が表示されていると思う。
 ・で、これを印刷すると、見た目と同じに、後が切れることなく印刷される。

 なので、印刷のためであれば、ユーザーフォームのテキストボックスに打ち込まれた、そのものをシートのラベルに
いれてはいかがですかと、そうアドバイスされているんだと思う。

 Sub Test()
    With ActiveSheet.Shapes(1)
        .Height = Range("B2:B7").Height
        .Width = Range("B2:D2").Width
        .Left = Range("B2").Left
        .Top = Range("B2").Top
        With .DrawingObject.Object
            .Caption = "あいうえお" & vbCrLf & "かきくけこさしすせそたちつてとなにぬねの" & vbCrLf & "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
        End With
    End With
 End Sub

 ついでに（？）ｍｏｍｏさんのJustifyも魅力的な提案。
半角文字だけだと反応しないのがネックなんだけどね。
でも、この条件でＯＫなら、Justufyの前に Application.DisplayAlerts = False
Jstifyの後に　Application.DisplayAlerts = True をいれて試してみてはいかが？
（この場合、文字列を入れるセル、おそらく、今、たてに結合されていると思うけど
　結合をはずして試してみるといいよ）

 (ぶらっと)

 ３０文字事に次の行のセルに分割していくという事なら、
割り付け機能が有効かも。
みやほりん

 ぷらっとさんの記述で良いと思いますが、
 ラベルのWidthは、大事をとって、セルのWidthより、小さくするで試して見てください。
 心配なのは、ActivexConntrolとシートの相性の悪さですが、
 （テキストボックスで右寄せの設定だと表示されない場合がある　Excel2000
 なんて現象がありました、Excel2002では、修正されていますが・・）

 ラベルとテキストボックスで試してみて、それでも駄目なら、フレームを配置し、
 その中にラベルやテキストボックスを配置し、試してみる。

 なんてところまで検証してみてください。

 ichinose

みやほりんさん

 割付機能はどこで設定するんですか？

ぶらっとさん、ichinoseさん

 テキストボックスに打ち込んだ値は決まったセルに入るわけじゃないのでその方法は適していないのではないでしょうか？理解し切れていないところありますが…。
 momoさんの提案の文も決まったセルでということですよね？

 >テキストボックスに打ち込んだ値は決まったセルに入るわけじゃないのでその方法は適していないのではないでしょうか？

 ？？？？？？？？？？

 このレスはすれ主さんからだと思うけど、どこのセルに入れるのかはスレ主さんがきめること。
回答者からアップされるコードは、あくまでヒントであったりコード部品。
「適していないのではないでしょうか」といわれてもねぇ・・

 じゃぁ、現状のコードでは、（改行は無視したとして）どのタイミングで、どのセルに入れようとしてるのかな？
こちらからは、「たとえばControlSourceで紐つけているとすれば」といってる。
それに対して、はいそうですとか、いいえ違いますといったレスももらっていない。

 そちらの「紐つけ要件」がどうなっているのかわからなければ、手も足も出せない。
こちらは、他人の頭の中を透視できないんだから。

 (ぶらっと)

ぶらっとさん

コマンドボタンを押します。

 >コマンドボタンを押します。

 で、ボタンを押したとき、テキストボックスの内容は、どのセルにもっていこうとしてる？
たとえば、そのときのアクティブセルってのもありうるけど、どうなのかな？

 それと、コメントアップするときは、ＨＮを必ずつけようね。

 (ぶらっと)

ぶらっとさん

 セルは決まってません。テキストボックスが3つあって、そこに入力する行数にもよりますので流動的です。
 例えばで、A1～A40のなかのどこかの場合でしたらどうなりますか？テキストボックス1の先頭は必ずA1ということで。

tachi

 300文字程度の入力するセルの数が多くとも3つということですか？

 でしたら、ラベルを使う方法でも有効だと思いますよ！！
 最初にラベルを三つ作成しておいて、初期設定を非表示にしておきます。
 入力したい位置が決定したら、ラベルを表示しその対象位置に移動し、
 サイズを調整すれば良いですね！！

 300文字程度のセルの数が10個程度なら、この方式で行えばよいと思います。

 これが1シートに50個ぐらいいえ、それ以上というなら、

 >その方法は適していないのではないでしょうか？

 に同意します。

 ichinose

 セルに対して1行です。テキストボックス内では改行して何行も書きます。
 テキストボックス１に10行書いたとして、セルは10個使います。(いまやりたい事が実現すれば+α)
 テキストボックス２の値は、12個目のセルから始まります。
 なので、使用するセルは決まってますが、入力されるセルは決まってないです。

 ichinoseさんの方法は、大きいセル３つっていうことですよね？それだと、打つ量によって間隔が広がったり、狭まったりしますよね？それでは見栄えが悪くなるので…。

 tachi

 ちょっと思ったのですが
 たちさんって、この前別の名前で質問されてなかったですか？
 で、実は　その続きなんですよね？

 (HANA)

 >ichinoseさんの方法は、大きいセル３つっていうことですよね？

 いいえ、大きいセルではなく、ラベルです。

 >それだと、打つ量によって間隔が広がったり、狭まったりしますよね？それでは見栄えが悪くなるので…。

 これは、Fontの問題ではないですか？

 例えば、ＭＳ ゴシックやＭＳ 明朝等の半角：全角＝1：2のフォントを選択すれば、
 解決できませんか？

 ichionse

 見落としていました。
文字の割り付けは2003までなら
編集＞フィル＞文字の割り付け
2007では
ホーム＞編集＞フィルメニュー＞両端揃え
　
のことです。
全角文字が対象で、一つのセルに入力された長い文字列を
複数行に列幅に収まるように振り分ける機能です。
（逆に、複数行に入力された短い文字列をまとめることもできる）
　
テキストボックスに入力されたものをセルに貼り付けて、
この割り付け（両端揃え）を使えば、フォントとか全角半角の
配慮しなくても、セルに収まる状態で文字数配分してくれるかな、
と。
（みやほりん）

 To みやほりんさん

 スレ主さんの入力作業では ABC 改行 EFGHI・・・・・　と明示的に改行させることもあるようなので
この場合、割り付けだと ABC が　セル内で A     B     C と文字の間隔があいちゃうのがネックかな？

 To tachi さん

 >セルは決まってません。テキストボックスが3つあって、そこに入力する行数にもよりますので流動的です。
 >例えばで、A1～A40のなかのどこかの場合でしたらどうなりますか？テキストボックス1の先頭は必ずA1ということで。

 「テキストボックスの先頭は必ずA1」という意味もわからないんだけど、さておき。

 ichinoseさんがアドバイスされ、私が補足したのは（ichinoseさんがレスしておられるように)ラベル。
 ラベルを３つ、シート上に作成して、その名前がLabel1,Label2,Label3だったとして
 UserFormのTextBox1にABC TextBox2にDEF TextBox3にHIJ と入力してコマンドボタンを押したとしよう。
 ABC DEF HIJ は、それぞれ、どのラベルにいれたいのかな？

 ラベルに限らず、これがセルだとしよう。それぞれの値を、どのセルにいれたいのかな？
 「まちまち」ですといわれても、ＶＢＡとしては、何か判断しなきゃいけない。

 仮に、ＶＢＡじゃなく、上記のように各TextBoxに入力した後、tachiさんが「手入力」で、
 各値をセルに書き込むとしたら、どのセルの書き込むの？

 その「書き込むべきセルの判断条件」をおしえてねといってるんだけど。

 追記）

 あぁ、わかったぞ。
上のAfterUpdateで提示したコードは、テキストボックスの内容を「１つのセル内に送り込んで改行させる」もので、
「そうじゃないよ」というレスがないものだから、その方式でいいと思ってた。
でも、どうやら、そうではなく
TextBox1の値はA1,A2,A3・・・・と分割していれていって、その下（可変）のA●からTextBox2の値を分割してセット。
さらに、その下に続けてA■からTextBox3の値を・・・・だね。
 であれば、（ichinoseさんは、とおの昔に、そう理解されていたようだけど）何行になるかわからないということで
1行ずつのセルの代わりに1行ずつのラベルを配置しなきゃいけなくなるので、「適さない」かな。

 （意図的な改行時には課題があるけど） みやほりんさんの割り付け、（A1から割り付け、次はA列最終行の１つ下から割り付け・・）
または、アップ済みのAfterUpdateのロジックで作成された文字列をvbCrLfで分解し直して、それをA1から順番にセットしていくのかな？
全角、半角の不揃いはなくならないけどね。

 (ぶらっと)

 ↑　という解釈でよければ
 (0:16コード一行訂正）

 Private Sub CommandButton1_Click()
    Dim txt As String
    Dim v As Variant
    txt = TextBox1.Value & vbCrLf & TextBox2.Value & vbCrLf & TextBox3.Value
    v = 分解(txt)
    Columns("A").ClearContents
    Range("A1").Resize(UBound(v) + 1).Value = WorksheetFunction.Transpose(v)
 End Sub

 Private Function 分解(txt As String) As Variant
    Dim s As Variant
    Dim v As Variant
    Dim x As Long
    Dim n As Long
    Dim d As String
    Dim t As String
    Dim k As Long
    Dim w As String

    v = Split(txt, vbCrLf)
    For Each s In v
        If Len(s) > 0 Then
            n = 0
            t = ""
            For x = 1 To Len(s)
                d = Mid(s, x, 1)
                If d = vbCrLf Then
                    n = 0
                Else
                    n = n + LenB(StrConv(d, vbFromUnicode))
                    If n > 30 Then    '★
                        t = t & vbCrLf
                        n = LenB(StrConv(d, vbFromUnicode))
                    End If
                End If
                t = t & d
            Next
            v(k) = t
        End If
        k = k + 1
    Next

    w = Replace(Join(v, vbCrLf), vbCrLf & vbCrLf, vbCrLf)
    分解 = Split(w, vbCrLf)

 End Function

 (ぶらっと)

コメント返信：

[ 一覧(最新更新順) ]

[[20111108124847]] 『テキストボックス内の自動改行』（たち) ページの最後に飛ぶ

[[20111108124847]]　『テキストボックス内の自動改行』（たち) 　ページの最後に飛ぶ