エクセルのVBA

エクセルのVBAを教えて頂きたいのですが。

Sheet1にテキストボックスが200個張り付いています。
テキストボックスの番号は1番から200番までです。
１つのテキストボックスに1文字のみ表記されています。
このような状態で、テキストボックスの文字が「(」であるものを見つけたら、以後、「)」を見つけるまでその間の文字の色を赤にするVBAを教えてもらいたいのですが。(「(」「)」も赤にします）

あいうえおかきくけ(こさしす)せそたちつてとなにぬねの(はひふ)へほ

上記の場合は
(こさしす)(はひふ)
が赤になります。

宜しくお願いします。

No.1 ベストアンサー 回答者： ja7awu 回答日時： 2003/10/03 19:28

> テキストボックスの番号は1番から200番までです。

この番号って、「名前」の後ろに付加されている番号のことですね。
現在は、デフォルトで付けられる "Text Box 1" のように名前が付いている
ものとしています。
違う場合は、コードの７行目で番号より前の部分を指定してください。
括弧は、半角/全角 どちらでも有効で、一応、先頭の文字を検出しています。

何回実行しても、現データで着色し直します。

指定した範囲の番号で、欠番があると、メッセージを出して中止します。
(欠番を無視する方法もありますが・・・)

これで如何でしょうか。

Sub StrColoring()
Dim Tb As TextBox
Dim N As Integer
Dim CMode As Boolean
On Error GoTo Err_Notfind
For N = 1 To 200
　　Set Tb = ActiveSheet.TextBoxes("Text Box " & CStr(N))
　　　　If StrConv(Left(Trim(Tb.Text), 1), vbNarrow) = "(" Then
　　　　　　CMode = True
　　　　　　Tb.Font.ColorIndex = 3
　　　　ElseIf StrConv(Trim(Tb.Text), vbNarrow) = ")" Then
　　　　　　If CMode = True Then
　　　　　　　　Tb.Font.ColorIndex = 3
　　　　　　　　CMode = False
　　　　　　Else
　　　　　　　　Tb.Font.ColorIndex = xlAutomatic
　　　　　　End If
　　　　Else
　　　　　　If CMode = True Then
　　　　　　　　Tb.Font.ColorIndex = 3
　　　　　　Else
　　　　　　　　Tb.Font.ColorIndex = xlAutomatic
　　　　　　End If
　　　　End If
Next N
Err_Notfind:
MsgBox "「Text Box " & CStr(N) & " 」が存在しません。" & _
　　　　" 終了します。", vbExclamation
Set Tb = Nothing
End Sub
　

No.10 回答者： ja7awu 回答日時： 2003/10/04 22:47

>　( [ ] ) は出現する。

この場合、"(" と ")" には色を付けないようにしています。
（あ[い]う）は考慮していません。無しですよね。

実行前は、全て黒色であるか、または規定の色とします。
一旦着けた色は、括弧内以外は元に戻しません。
こんなのでどうでしょうか。　あとは適当にいじってください。

Sub Strcoloring()
Dim Tb As TextBox
Dim N As Integer
Dim Coi As Variant
Dim CMode As Boolean
Coi = xlAutomatic
On Error Resume Next
For N = 1 To 200
　　Set Tb = ActiveSheet.TextBoxes("Text Box " & CStr(N))
　　If Err.Number <> 0 Then GoTo err_noobj
　　　　If StrConv(Left(Trim(Tb.Text), 1), vbNarrow) = "(" Then
　　　　　　CMode = True
　　　　　　Coi = 3
　　　　　　If StrConv(Left(Trim(ActiveSheet.TextBoxes("Text Box " & _
　　　　　　　　CStr(N) + 1).Text), 1), vbNarrow) <> "[" Then
　　　　　　　　Tb.Font.ColorIndex = Coi
　　　　　　Else
　　　　　　　　Tb.Font.ColorIndex = xlAutomatic
　　　　　　End If
　　　　ElseIf StrConv(Left(Trim(Tb.Text), 1), vbNarrow) = ")" Then
　　　　　　Tb.Font.ColorIndex = Coi
　　　　　　CMode = False
　　　　　　Coi = xlAutomatic
　　　　ElseIf StrConv(Left(Trim(Tb.Text), 1), vbNarrow) = "[" Then
　　　　　　Coi = 5
　　　　　　Tb.Font.ColorIndex = Coi
　　　　　　CMode = True
　　　　ElseIf StrConv(Left(Trim(Tb.Text), 1), vbNarrow) = "]" Then
　　　　　　Tb.Font.ColorIndex = Coi
　　　　　　CMode = False
　　　　　　Coi = xlAutomatic
　　　　Else
　　　　　　If CMode = True Then
　　　　　　　　Tb.Font.ColorIndex = Coi
　　　　　　End If
　　　　End If
err_noobj:
Err.Number = 0
Next N
Set Tb = Nothing
End Sub

この回答へのお礼

ご回答ありがとうございました。

＞>　( [ ] ) は出現する。
＞この場合、"(" と ")" には色を付けないようにしています。
＞（あ[い]う）は考慮していません。無しですよね。

いえ、無しではないです(笑)
普通の文では"( )" だけとか"[ ]"だけで用いないのと同じで、"( )"や"[ ]"は文字を囲うために用いていました。
ですので、文字無しで"( [ ] )"というのは出現しません。
作って頂いたものは"(あ[い]う）"のような時は　"う)"　の色が変わりませんので、自分で改良してみました。
Boolean　を二つ用いて何とかうまくいきました。

お礼日時：2003/10/05 21:36

No.9 回答者： ja7awu 回答日時： 2003/10/04 15:02

> ようするに、文字を並べて絵を作っているという感じです。

なるほどね。
ちょっと、シツコイと言われそうですが、それだったらセルを使っても出来ると
思います。
ただ、テキストボックスのように個々の配置が、バラバラには出来ませんが・・・
規則正しく並んでいるときは、セルでもいいと思いますが、どうなんでしょう。

この回答への補足

＞規則正しく並んでいるときは、セルでもいいと思いますが、どうなんでしょう。

セルでは表示不可能な形になっています。

補足日時：2003/10/04 15:52

No.8 回答者： ja7awu 回答日時： 2003/10/04 13:57

> (テキストボックスの数は実際は1000を超えています)

しかし、追加質問を考える前に、テキストボックスをこんなに大量に使って、
こんなことするより方法がないのかと、ちょっと考えてしまいますね。

セルをVBAで操作するのはダメなんですかね。
用途が解らないから、ちょっと疑問でぇ～す。

この回答への補足

No7での説明が不十分でした。
(　)　[ ] は必ず対で用いています。

補足日時：2003/10/04 14:27

この回答へのお礼

ご質問にお答えします。

＞セルをVBAで操作するのはダメなんですかね。

ようするに、文字を並べて絵を作っているという感じです。

お礼日時：2003/10/04 14:17

No.7 回答者： ja7awu 回答日時： 2003/10/04 13:38

Tb.Font.ColorIndex = xlAutomatic　の行は、２つありますが、

まず、最初の方が無いと・・・

今、(abc)de があって、実行結果"(abc)" が、赤になったとします。
今度は　( を "x"等に変更して実行すると、"xabc" までは黒に戻りますが、
残った ) が 赤のままになると思います。

2つ目も同じようにテキストボックスの内容を変更したときに対応させるため
には、必要なのです。

そうでないと一旦、括弧の中で赤になったものをデータを変更して括弧の外へ
出たときに、黒に戻らないのです。

まぁ、その辺の機能が不要であれば、削除してもいいのですが、動作は同じでは
ありません。

今の所、気が付かないだけと思います。
一応、あらゆる事態を想定しましたので・・・気の使い過ぎ？？

この回答へのお礼

ご回答ありがとうございました。

＞今度は　( を "x"等に変更して実行すると、"xabc" までは黒に戻りますが、
＞残った ) が 赤のままになると思います。

基本的に「今度は」はないです。
実はシート自体も何十も用意しているような状態で、一つのシートを使いまわす環境ではないです。
ですので、処理速度が速ければ速いほど助かることになります。

お礼日時：2003/10/04 14:13

No.6 回答者： taisuke555 回答日時： 2003/10/04 13:02

koala3さん、ja7awuさん補足ありがとうございました。

そんな所にもテキストボックスが・・・
というより私もそちらの方を普段使っていました。

ＶＢＡでという事で、コントロール ツールボックスしか
頭にありませんでした。

おかげで何故？とおもっていた事が分かりすっきりしました。

質問者の質問ではないのに補足頂きありがとうございました。

No.5 回答者： ja7awu 回答日時： 2003/10/04 11:29

taisuke555 さんへ

原因は、コントロール ツールボックスのテキストボックスを使用した
からですね。

200個もあるのですから、普通は操作性(配置等ほとんど)が悪いので使わない
と思いますよ。
オートシェーブを使うのが一般的かと・・・?

ツールボックスのテキストボックスにすれば、そのコードで、間違いなく
動作しています。


koala3 さんへ

追加質問、ちょっと待っててね。

この回答へのお礼

ご回答ありがとうございました。

＞追加質問、ちょっと待っててね。

続けざまに質問してしまって申し訳なく思ってます。
あと、気づいたことですが、

Else
Tb.Font.ColorIndex = xlAutomatic

上記を削除して試してみると、結果は同じでかつ処理速度が格段に早くなりました。
(テキストボックスの数は実際は1000を超えています)

お礼日時：2003/10/04 12:16

No.4 回答者： taisuke555 回答日時： 2003/10/04 04:44

＃２です。

やっぱり、できませんでしたか。（私のではこれで動くのですが・・・）

私の方では、＃１さんのコードが実行できなかったので、
もしかしたらとは思いましたが・・・

私の環境は、Windows98 Excel2000
コントロール ツールボックスのテキストボックスを使用しています。

koala3さんはどうですか？
（＃１さんの回答でできたみたいなので、私のは無視して頂いていいのですが、
　できたら今後の為に教えてください。）

ja7awuさん、もし何か知っていたら教えてください。

とにかく、間違えたコードを載せてしまい、申し訳ありません。

この回答へのお礼

ご回答ありがとうございました。

＞コントロール ツールボックスのテキストボックスを使用しています。

これが原因のようです。
こちらの環境は、図形描画のテキストボックスでした。

お礼日時：2003/10/04 11:11

No.3 回答者： ja7awu 回答日時： 2003/10/03 22:22

No.1 ですが・・・　ちょっと書き漏らしで～す。

各テキストボックスが１文字ということで、小さいのでリターンコードが
入っていても気が付かないことがあると思いますので、括弧閉じ ")" を検出
する11行目も "(" と同様に先頭の１文字を検出するように下記のようにした方が、
いいと思いますので修正してください。
実際やってみると結構「リターンコード」が入っていますね。

11行目の修正
ElseIf StrConv(Trim(Tb.Text), vbNarrow) = ")" Then
　　　　↓
ElseIf StrConv(Left(Trim(Tb.Text), 1), vbNarrow) = ")" Then


あと、テキストボックスの番号に欠番があっても無視する場合は、次のコードを
使ってください。

Sub Strcoloring()
Dim Tb As TextBox
Dim N As Integer
Dim CMode As Boolean
On Error Resume Next
For N = 1 To 200
　　Set Tb = ActiveSheet.TextBoxes("Text Box " & CStr(N))
　　If Err.Number <> 0 Then GoTo err_noobj
　　　　If StrConv(Left(Trim(Tb.Text), 1), vbNarrow) = "(" Then
　　　　　　CMode = True
　　　　　　Tb.Font.ColorIndex = 3
　　　　ElseIf StrConv(Left(Trim(Tb.Text), 1), vbNarrow) = ")" Then
　　　　　　If CMode = True Then
　　　　　　　　Tb.Font.ColorIndex = 3
　　　　　　　　CMode = False
　　　　　　Else
　　　　　　　　Tb.Font.ColorIndex = xlAutomatic
　　　　　　End If
　　　　Else
　　　　　　If CMode = True Then
　　　　　　　　Tb.Font.ColorIndex = 3
　　　　　　Else
　　　　　　　　Tb.Font.ColorIndex = xlAutomatic
　　　　　　End If
　　　　End If
err_noobj:
Err.Number = 0
Next N
Set Tb = Nothing
End Sub

この回答へのお礼

ご回答ありがとうございました。
うまくいきました。

もし以下のように処理内容を追加したら、どんな感じになるでしょうか。


あいうえ[おかき]くけ(こさしす)せそたち[つて]となにぬねの(はひふ)へほ

上記の場合、(こさしす)(はひふ)　　は赤に
　　　　　　 　　[おかき][つて]　　　　は青に
　　　　　　 　　それ以外　　　　　　　は黒に　　　　　　　

( [ ) ] ・　[ ( ) ]のようなケースは出現しないが、( [ ] ) は出現する。この場合は[ ] 及びその中の文字は青になる。

お礼日時：2003/10/04 03:25

No.2 回答者： taisuke555 回答日時： 2003/10/03 21:17

＃１の方と似たような感じですが

私とは、設定するプロパティが違っていたので
一応、私も記載しておきます。
同じでも芸が無いので、テキストボックスが無くても
続行できるようにしてみました。(EXCEL2000)

Sub test()
　　Dim Tx As Object
　　Dim wColor As Long
　　Dim i As Integer

　　On Error GoTo wErr
　　'初期値は黒
　　wColor = &H0
　　For i = 1 To 200
　　　　Set Tx = ActiveSheet.OLEObjects("TextBox" & CStr(i)).Object
　　　　If (Not Tx Is Nothing) Then
　　　　　　'（ならば赤色をセット
　　　　　　If (StrConv(Tx.Value, vbNarrow) = "(") Then
　　　　　　　　wColor = &HFF
　　　　　　End If
　　　　　　'テキストボックスのForeColorを変更する
　　　　　　Tx.ForeColor = wColor
　　　　　　'）ならば黒色をセット
　　　　　　If (StrConv(Tx.Value, vbNarrow) = ")") Then
　　　　　　　　wColor = &H0
　　　　　　End If
　　　　End If
　　Next i
　　Set Tx = Nothing
　　Exit Sub
wErr:
　　If (MsgBox("TextBox" & CStr(i) & "が見つかりません" & Chr(13) & "作業を続けますか？", vbYesNo) = vbYes) Then
　　　　Resume Next
　　End If
End Sub

１文字という事でしたのでその部分処理していませんが、
必要ならば追加してください。

この回答へのお礼

ご回答ありがとうございました。
実行させてもらいましたが、いきなり「TextBox1が見つかりません」というメッセージが出現して、作業を続けると以後メッセージが出続けるという状況でした。

お礼日時：2003/10/04 03:17