Word VBA テキストボックス内の文字取得方法

このQ&Aのポイント
  • 質問者はWordのVBAで漢字の後ろに「☆★」を入力するマクロを作成していますが、テキストボックス内の文字には付けることができません。
  • テキストボックス内の文字を取得するためにはどうすればよいか悩んでいます。
  • 質問者は既存のマクロではうまくいかないため、解決策を探しています。
回答を見る
  • ベストアンサー

Word VBA テキストボックス内の文字

仕事で、総ルビをしなければならず、漢字の後ろに「☆★」を入力するマクロを組みました。 例えば「漢☆★字☆★」をマクロで入力させ、あとは手入力で「漢☆かん★字☆じ★」と打ち、本で載っていたマクロで、ルビを振る、という手順で考えています。 しかし、テキストボックスに入っている文字に、「☆★」を付けることができませんでした。 テキストボックス内の文字を取得するには、どうすればいいでしょうか? ちなみに、漢字の後ろに「☆★」を付けるマクロは、 Option Explicit Sub Test() Dim i As Integer Dim s As String On Error Resume Next For i = 1 To 9999 s = ActiveDocument.Range(Start:=i - 1, End:=i).Text If Asc(s) < -950 And Asc(s) > -30560 Then ActiveDocument.Range(Start:=i, End:=i).Text = "☆★" End If Next i End Sub です。 全くひどいマクロですが、テキストボックス以外の部分では、それなりに結果が出ています。 「それなりに」というのは、なぜか、行頭に「☆★」が挿入されてしまう場合があったのです。 でも、それはどうせ手作業をいろいろやらないといけないので、今は無視して、テキストボックス内の文字にも、同じように「☆★」を付けたいのですが、このマクロでは、全くダメでした。 もし、お分かりになる方がおられましたら、よろしくお願い致します。

質問者が選んだベストアンサー

  • ベストアンサー
  • dogs_cats
  • ベストアンサー率38% (278/717)
回答No.1

専門家でもありませんし、word VBAを使用する事もありませんのでご参考まで。 Sub test() Dim shp As Shape Dim txt, buf, mystr As String Dim i, CD As Long Dim flag As Boolean For Each shp In ActiveDocument.Shapes If shp.Type = msoTextBox Then txt = shp.TextFrame.TextRange.Text mystr = "" For i = 1 To Len(txt) - 1 '漢字判定用フラグ flag = False '1文字づつ取得 buf = Mid(Trim(txt), i, 1) '文字列を全角変換 CD = Asc(StrConv(buf, vbWide)) If CD < -950 And CD > -30560 Then flag = True 'If CD >= -30561 And CD <= -26510 Then flag = True 'If CD >= -26415 And CD <= -5468 Then flag = True 'If CD >= -1444 And CD <= -949 Then flag = True If flag = True Then mystr = mystr & buf & "☆★" Else mystr = mystr & buf End If Next i shp.TextFrame.TextRange.Text = mystr End If Next shp End Sub テキストボックの文字取得は下記サイトのコードを利用 http://www.relief.jp/itnote/archives/word-vba-get-strings-text-boxes.php 下記のコードは http://okwave.jp/qa/q2176398.html で記載してあったコードです。 もしコードで漢字判定で漢字で無いものが漢字判定された場合は下記をお試し下さい。現在はコメントなるようにシングルクォーテーションを入れてありますので動作はしません。 'If CD >= -30561 And CD <= -26510 Then flag = True 'If CD >= -26415 And CD <= -5468 Then flag = True 'If CD >= -1444 And CD <= -949 Then flag = True

Prome_Lin
質問者

お礼

ありがとうございます! とり急ぎのお礼です。 実行してみたところ、1番最初に見つかったテキストボックスにしか「☆★ が付きませんでした。 ちゃんと、「For Each shp In ActiveDocument.Shapes」で「Shapes」を探しているはずなのに・・・ 私なりに、もう少し調べさせていただきます。 また、私もネットで探したつもりでしたが、全然見つからなかったのに、見つけていただき、ありがとうございました。

Prome_Lin
質問者

補足

ありがとうございました。 時間がないので、十分な検証は出来なかったのですが、もう、テキストボックス内の文字については、いったん、新規作成した文書にコピー&ペーストし、そこでルビの作業をしてから、元に戻すことにしました。 ありがとうございました。 Word VBAは、ふだん、全く使わないので、全然分かりませんが、仕事が落ち着いてから、ゆっくり考えてみます。

関連するQ&A

  • ワード VBA

    ワードのマクロについて教えてください。 以下のようなマクロをボタンに登録しています。 Sub Macro10() Dim myReg As Object Dim st As String Dim match As Variant Set myReg = CreateObject("VBScript.Regexp") myReg.Pattern = "\x0d\x0d(|$)" myReg.Global = True st = ActiveDocument.Range.Text ActiveDocument.Range(1, 1).Select For Each match In myReg.Execute(st) With Selection .Find.Text = match.Value .Find.Replacement.Text = vbCr .Find.Execute , , , , , , , , , , wdReplaceAll End With Next st = ActiveDocument.Range.Text If myReg.Test(st) Then _ ActiveDocument.Range.Text = myReg.Replace(st, "") Set myReg = Nothing End Sub ここで教えていただきたいのは,上記のマクロを実行するためにボタンを押した際,実行前にカーソルが置かれていたのと同一の場所に実行後のカーソルを戻す方法です。(ちなにみ上記のマクロを実行する際にカーソルが置かれているのは,空白行ではない行の先頭です。※処理とは関係ないかもしれませんが,念のために。) そのような処理を行うには,上記のマクロにどのような記述を追加すればよいのでしょうか。 どなたかご教示いただければと思います。 どうぞよろしくお願いいたします。

  • Word VBA テキストボックスのフォントサイズ

    Wordでマクロを組んでいます。 文書内から取得した値を変数へ格納し、複数の変数をつないでテキストボックスに入れ、文書へ追加しています。 このテキストボックスの文字のフォントサイズを前と後ろで変えたいのですが、色々試していますがうまくいきません。 お分かりになる方がいらっしゃいましたら教えてください! 以下コードです。 下記の「EIJI」のみフォントサイズを20ptにしたいのです。 変数に格納する文字列は都度変化し、文字数も変わります。 よろしくお願いします! Sub try() Dim KANA As String, KATAKANA As String, EIJI As String KANA = "あああ" KATAKANA = "アアア" EIJI = "AAA" Dim myTxt As String myTxt = KANA & "/" & KATAKANA & "/" & EIJI Dim objTextBox As Object Set objTextBox = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 25, 20, 530, 25) objTextBox.Select With Selection .Font.Size = 16 .TypeText Text:=myTxt End With End Sub

  • テキストボックスの表示について

    いつもお世話になります。VBAで質問があるのですが、ユーザーフォームを作り、コマンドボタンとテキストボックスを配置します。 Private Sub CommandButton1_Click() Dim i As Long  For i = 1 To 30   TextBox1.Text = i & "を入力しました"   Worksheets("Sheet1").Range("A1").Value = i & "回目です"  Next i End Sub と入力して実行すると、セルには1~30回まで順に書き込みがありますが、テキストボックスには最後の「30を入力しました」しか表示されません。 これを「1を入力しました」、「2を入力しました」、「3を・・・」というようにテキストボックスに順に表示させるにはどのようにしたらよいのでしょうか? よろしくお願いします。

  • EXCEL VBA 記号の削除

    A列3行目からはじまる(A列2行目タイトル=FA)データより"!"や"#"などの記号を取り除いた ものをE列に表したいと思っています。 データを半角にして、ASC関数を使って記号を取り除こうとしたのですが、半角になるだけで 記号を取り除くことができません。 If の後、ASC関数は使用せず、"!"や"#"を指定しても結果が同じだったんですが REPLACEの使い方が間違っているのでしょうか? Dim セル As Range Dim TARGET As Range Dim 変換文字 As String Dim i As Long Dim W As Worksheet Set W = Sheets("DATA転記") Set TARGET = W.Range("A3", Range("A65536").End(xlUp)) For Each セル In TARGET 変換文字 = StrConv(セル.Text, vbNarrow) For i = 1 To Len(変換文字) If Asc(変換文字) >= 32 And Asc(変換文字) <= 47 And _ Asc(変換文字) >= 58 And Asc(変換文字) <= 64 And _ Asc(変換文字) >= 91 And Asc(変換文字) <= 96 And _ Asc(変換文字) >= 123 And Asc(変換文字) <= 126 Then _ 変換文字 = WorksheetFunction.Replace(変換文字, i, 1, "") End If Next i セル.Cells(, 5).Value = StrConv(セル.Text, vbWide) Next セル

  • WORDマクロエラー

    Wordでテキストボックスをレイアウト枠に変換するマクロを作りました。 簡単なコードだと思うのですが、「オブジェクト変数またはブロック変数が設定されていません」というエラーが出てしまいます。 どこに原因があるのでしょうか? Sub テキストボックス変換() Dim i Dim sp As Shape For i = 1 To ActiveDocument.Shapes.Count If sp.Type = msoTextBox Then sp.ConvertToFrame End If Next End Sub

  • Excel VBA ユーザーフォームのテキストボックスで

    Excel2000or2003でマクロを作っております。 ユーザーフォームのテキストボックスで、例えば時間を入力するとします。 Private Sub TextBox1_Change() Worksheets("Work").Range("B3").Value = TextBox1 End Sub と書いたところ、セルには数値としてではなく文字として入ってしまうようで、後のルーチンで計算できません。 数値として扱うには、どうしたら良いでしょうか? お手数ですが、ご教授願います。

  • Excel VBA テキストボックスを検索

    テキストボックス3に数値を入力し ExcelのA列にあるか検索をかける。 ある場合は、B列の同じ行に 「みーつけた!」と入力。 その設定で組んでみたのですが、 テキストボックス3にデータを6桁入力しようとすると 6桁目にオーバーフローエラーが出ます。 このプログラムの何処がおかしいのでしょうか? Private Sub TextBox3_Change() Dim Number As Integer If TextBox3.Value <> "" Then '空じゃない場合 Number = TextBox3.Value Call 検索(Number) MsgBox TextBox3.Value End If End Sub Sub 検索(ByVal Number As Variant) Dim FoundCell As Range Set FoundCell = Range("A:A").Cells.Find(What:=Number, lookat:=xlPart) If FoundCell Is Nothing Then Else FoundCell.Activate Range("O" & ActiveCell.Row).Value = "みーつけた!" End If End Sub

  • コンボボックスとテキストボックスをセルへ

    コンボボックスのデータを行へ表示されるよう下記の通りやりました。 続けてテキストボックスを指定した同じ行のセルへ入力されるように したいのですが、いろいろ調べたのですが、解決できず ここで助言いただけたらと思います。 また textbox1はA列 textbox2はB列 textbox3はM列 へとコンボボックスのデータを挟む形での入力となります。 ちなみにテキストボックスのプロジェクト名は変更してあります。 Private Sub CommandButton1_Click() Dim lrow As Long, i As Long With Worksheets("製品化") lrow = .Range("F" & Rows.Count).End(xlUp).Row For i = 0 To 6    .Cells(lrow + 1, i + 6).Value = itemname.List(listno, i) Next i End With End Sub

  • EXCEL2003 VBAのテキストボックス

    ユーザーフォームからの入力・操作のみでシート上の住所録を編集出来るものを作ろうとしております。 テキストボックスの値の操作についての質問なのですが、端的に説明しにくいので自分で記述したコードと共に説明させていただきます。 シートはA列に氏名、B列に住所が入るようにし、100件のデータを格納出来るようにします。1行目はタイトルです。 セル範囲の名前は以下のように定義付けしています。  A2:A101 「氏名」  A2:B101 「住所録」 ユーザーフォームには以下のオブジェクトを配置しております。  「名前」入力・出力用テキストボックス(オブジェクト名:TB1)  「住所」入力・出力用テキストボックス(オブジェクト名:TB2)  名前検索用コンボボックス(オブジェクト名:CMB)  「追加」コマンドボタン(オブジェクト名:CB1)  「訂正」コマンドボタン(オブジェクト名:CB2) まずは新規データの入力。テキストボックス(TB1, TB2)に入力した後の「追加」コマンドボタン(CB1)クリック時の処理は以下のコードでうまくいっております。 Private Sub CB1_Click() Range("A65536").End(xlUp).Select Selection.Offset(1, 0).Select Selection = TB1 Selection.Offset(0, 1).Select Selection = TB2 Range("住所録").Sort _ Key1:=Range("A2"), _ Order1:=xlAscending, _ Header:=xlNo, _ OrderCustom:=1, _ MatchCase:=False, _ Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin End Sub 同じテキストボックス(TB1, TB2)を使いデータの訂正をする為、コンボボックス(CMB)に以下のコードを記載しました。 尚、コンボボックスのRowSourceは「氏名」です。 Private Sub CMB_Change() Dim AA As String AA = CMB.Value TB1.Value = Application.WorksheetFunction.VLookup(AA, Range("住所録"), 1) TB2.Value = Application.WorksheetFunction.VLookup(AA, Range("住所録"), 2) End Sub これでコンボボックスで選択した名前からテキストボックスに名前と住所を表示することができました。 ここからが上手くいきません テキストボックスに表示された文字を同じテキストボックス上で変更し、変更後の情報を「訂正」コマンドボタン(CB2)クリックでシート上に送るために以下のコードを記述しました。 Private Sub CB2_Click() Dim BB As String BB = CMB.Value Dim CC As Range Set CC = Range("氏名").Find(what:=BB, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows) Cells(CC.Row, CC.Column).Select Selection = TB1 Selection.Offset(0, 1).Select Selection = TB2 Range("住所録").Sort _ Key1:=Range("A2"), _ Order1:=xlAscending, _ Header:=xlNo, _ OrderCustom:=1, _ MatchCase:=False, _ Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin CBM.ListIndex = -1 End Sub これを実行してもシートには訂正後の情報が反映されず訂正前の情報が入ってしまいます。 ここで訂正後の情報を反映させるためにはどうしたらよろしいのでしょうか。

  • ワードでのテキストボックス

    Wordを使って文章の作成をしているのですが (オートシェイプの図形やテキストボックスを使った文字なども入れてあります。) テキストボックスで文字を入力すると全く別の違う場所へも テキストボックスで入力した文字が入ってしまいます…。 他のテキストボックス内の文字は異常ないのですが 新しくテキストボックスをクリックして文字を入力しようとすると 別の場所へ(別のテキストボックスではなく、 通常の文字入力スペースでもなく中途半端なところへ)文字が入ってしまうのです。 原因が全くわかりません。 何かおかしな設定をしてしまったのでしょうか…。 どなたか分かる方いらっしゃいましたらお願いします!

専門家に質問してみよう