• ベストアンサー
※ ChatGPTを利用し、要約された質問です（原文：Word2003でドキュメント内の赤色文字の文字数をカウントする方法について）

Word2003でドキュメント内の赤色文字の文字数をカウントする方法

このQ&Aのポイント
  • Word2003でドキュメント内の赤色文字の文字数をカウントする方法についてマクロを作成していますが、最終段落の段落記号に赤色が設定されていると無限ループしてしまいます。
  • 赤色文字の文字数をカウントするためには、赤色の文字を検索し、その文字数をカウントしていく必要があります。
  • ただし、上記の方法では最終段落の段落記号に赤色が設定されていると無限ループしてしまうため、最終段落の段落記号に対しては特別な処理を行う必要があります。

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

  • ベストアンサー
回答No.1

.SetRange .End, .End で検索開始位置が初期化されてしまうのがいけないようですね。 .SetRange .End, .End を削除、もしくは、コメントアウトすると、無限ループにならないようです。

makochan07
質問者

お礼

おかげさまで解決しました。 本当にありがとうございます。

全文を見る
すると、全ての回答が全文表示されます。
  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. その他（プログラミング・開発）

関連するQ&A

  • 数字「0」の入力を文字数としてカウント

    入力した文字数が7桁でないとエラーメッセージを表示する処理（下記）を作成しました。 入力した文字の先頭が「0」の場合、または「00」の場合に、「0」「00」を含む文字数をカウントし、 エラーメッセージを表示させ、更に表示書式を”000-0000”（郵便番号）としたい。 ご教示をお願い致します。 Private Sub Worksheet_Change(ByVal Target As Range) Dim wCellVal As String With Worksheets("Sheet1") wCellVal = .Cells(Target.Row, Target.Column).Value End With If Target.Address(False, False) = "A1" Then If Len(wCellVal) <> 7 Then '文字数チェック MsgBox "7桁で入力してください。", vbOKOnly + vbExclamation, "入力エラー" Exit Sub End If End If End Sub よろしくお願い致します。

  • VBSでWoｒｄの文字色変え

    VBSなのですが Wordファイルをドラッグしたら <と>で囲まれた文字の色を変更して保存する というものを考えております が <============= 部分でコンパイルエラー（ステーメントがありません） が発生します 初心者でさっぱりわからないのですが どなたかお助けを！ よろしくお願いいたします 以下ソース Dim objWord Dim f Dim m If WScript.Arguments.Count<1 Then m="Hello!" MsgBox m WScript.Quit End If Set objWord=CreateObject("Word.Application") objWord.Visible=True For Each f In WScript.Arguments objWord.Documents.Open f objWord.Selection.Find.ClearFormatting objWord.Selection.Find.Replacement.ClearFormatting objWord.Selection.Find.Replacement.Font.Color = wdColorRed With objWord.Selection.Find .Text = "\<[!\>]@\>" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchFuzzy = False .MatchWildcards = True End With objWord.Selection.Find.Execute Replace:=wdReplaceAll '<======================= objWord.ActiveDocument.SaveAs f&".doc" objWord.ActiveDocument.Close Next objWord.Quit WScript.Quit

  • wordマクロで条件に合う文のみフォントサイズ変更

    wordの文章で、“（注）”もしくは“(注)”という文字列を検索して次に現れる空白改行までの文章を9ptにし変えた部分にマーカーをしたいと思っています。 (注)から始まる文章は (注)あああああ。 (注)ああああ。いいいいい。 (注)ああああ。 　　（1）いいいいい。 　　　　(1)ううううう。 　　　　(2)えええええ。 等のパターンがあります。現行では”ああああ”しか9ptになりませんが本当は全て9ptにしたいと思っています。どなたがご教授願います。 Sub SizeChenge9() Dim Rng As Range For Each Rng In ActiveDocument.StoryRanges With Rng.Find .Text = "[\(（][注][\)）]" .MatchWildcards = True Do While .Execute(Forward:=True) If Rng.Information(wdWithInTable) = False Then With Rng .EndOf Unit:=wdSentence, Extend:=wdExtend .Font.Size = 9 .HighlightColorIndex = wdPink .Collapse wdCollapseEnd End With End If Loop End With Next Rng End Sub

  • Wordの文章中の一致した文字のある段落を削除する

    MS-Wordの文章を検索して行頭に一致した文字がある段落を削除するマクロを作りたいと思いチャレンジしています。 たとえば，文章を頭から順に検索して，行頭にある文字が検索文字と一致した場合，その段落を削除して，次の行を検索し続け，文書が終わったら終了するようなマクロです。 小生，WordVBAを２日ほど前から学び始めたばかりで，ネットや参考書を探しまして，"@"マークが行頭にある段落を削除するというサンプルを作るところまでは何とかできたのですが，これを文章全体に一括して実行できるマクロにするにはどうすればよいかに手こずっています。 このマクロがあると仕事の効率がぐんとアップしますので，何とかしたいと思っています。 是非ご教いただければ大変ありがたく思います。 ＜サンプル＞ Sub test_DeleteParagraph() Selection.HomeKey Unit:=wdStory, Extend:=wdMove With Selection.Find .Forward = True .ClearFormatting .MatchWholeWord = True .MatchCase = False .Wrap = wdFindContinue If .Execute(FindText:="@", Forward:=True, Format:=True) = True Then Selection.HomeKey Unit:=wdLine, Extend:=wdMove Selection.MoveDown Unit:=wdParagraph, Extend:=wdExtend lVal = Selection End If Selection.Delete End With Selection.Find.ClearFormatting End Sub

  • WORD　VBA　繰り返し処理

    WORD　VBAについて教えてください。 つぎのようなマクロがあり、これを検索する文字列がなくなるまで、繰り返して、処理するようにしたいのですが、どうすればよいのでしょうか？ Sub Macro1() Selection.Find.ClearFormatting With Selection.Find .Text = "あ" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = True End With Selection.Find.Execute Selection.MoveRight Unit:=wdCharacter, Count:=1 End Sub

  • ＷＯＲＤ　ＶＢＡでハイパーリンクの文字列色変更

    ＶＢＡの初心者です。教えてください。 色々なＷＥＢサイトより情報を集めてＷＯＲＤ文書を作成しています。フォント名、サイズ、色がバラバラで、それを統一するＶＢＡは以下のように出来たのですが、ハイパーリンクされている文字の色も黒になっています。ハイパーリンクされている文字色だけは本来の青色で表示したいのですが、どのようにしたらいいのか分かりません。よろしくお願いします。　(WORD2007 Windows7) Sub フォント変換() ' ' With ActiveDocument.Content.Find .Text = MatchiWildcards .Format = True .Font.Size = 11 With .Replacement .Font.Name = "ＭＳ Ｐゴシック" .Font.Size = 10.5 .Font.Color = wdColorBlack .Font.Bold = False End With .Execute Replace:=wdReplaceAll End With With ActiveDocument.Content.Find .Text = MatchiWildcards .Format = True .Font.Size = 12 With .Replacement .Font.Name = "ＭＳ Ｐゴシック" .Font.Size = 10.5 .Font.Color = wdColorBlack .Font.Bold = False End With .Execute Replace:=wdReplaceAll End With End Sub

  • 作成方法についての質問です。

    下記のマクロで実行すると添付画像[現状]のようになってしまいます。 私としては[こうなってほしい]の形にしたいのですが、どこに何を組み込めばよいかわかりません。 誰か教えてください。 Dim Matches As Object Dim Match As Object Dim i As Long, j As Long Dim a As Variant With CreateObject("VBScript.RegExp") Set rng = Range("A1", Cells(Rows.Count, 1).End(xlUp)) Application.ScreenUpdating = False For i = 1 To rng.Rows.Count If InStr(1, rng.Cells(i, 1).Value, "(", 1) > 0 Then .Pattern = "\(([A-z\d,]+)" Else .Pattern = "([A-z\d,]+)" End If .Global = True Set Matches = .Execute(StrConv(rng.Cells(i, 1).Value, vbNarrow)) If Matches.Count > 0 Then a = Matches(0).SubMatches(0) a = Split(a, ",") Cells(i, 2).Resize(, UBound(a) + 1).Value = a End If j = 0 Next End With Application.ScreenUpdating = True Set rng = Nothing End Sub

  • Wordのマクロの繰り返しと停止

    Wordで"XX"の場所に"★"の後にある文字列を挿入、という以下のマクロを記録したのですが、この作業を★がなくなるまで繰り返したいと思っております。どのように記入すればよいでようか？ Selection.HomeKey Unit:=wdStory Selection.Find.ClearFormatting With Selection.Find .Text = "★" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = False End With Selection.Find.Execute Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.EndKey Unit:=wdLine, Extend:=wdExtend Selection.Cut Selection.HomeKey Unit:=wdStory Selection.Find.ClearFormatting With Selection.Find .Text = "XX" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = False End With Selection.Find.Execute Selection.Paste Selection.TypeBackspace End Sub

  • ワードVBAで、段落のタブの数を数えたい。

    ワード2002使用です。 ２段落目に複数のタブが入力されています。 ワードVBAで、選択した段落のタブの個数を数えたい。 sub タブ（） Dim tab数 As Integer ActiveDocument.Paragraphs(2).Range.Select tab数 = Selection.Paragraphs.tabs.Count←ここがよくわかりません msgbox　tab数 end　sub よろしくお願いします。

  • Word2007のマクロについて

    こんにちは。 Word2007のマクロについて質問させて下さい。 ・タイトル行が(16738047)色で、本文が黒文字の日本語の文書があります。 ・タイトル行内でキーワード検索を行いたいです。 ・1個ずつ内容を確認したいので「次を検索」 MsgBoxを使用しています。 以下のコードを実行すると、単語が1個飛ばしに選択されてしまいます。 どこを変更すればいいでしょうか？ 教えてください。よろしくお願いします。 Sub タイトル検索() Dim myKW As String 'キーワード myKW = InputBox("検索する文字を入力して下さい") Selection.HomeKey Unit:=wdStory 'カーソルを文頭に移動 With Selection.Find .ClearFormatting .Font.Color = 16738047 .Text = myKW .MatchWildcards = False .MatchFuzzy = False If Len(myKW) = 0 Then Exit Sub If .Execute = True Then Do While .Execute If MsgBox("次を検索", vbokcansel, "確認") = vbOK Then Selection.Find.Execute End If Loop 　　MsgBox "処理が終了しました。" Else MsgBox "文字はありませんでした。" End If End With With Selection.Find ' 検索・置換のクリア .ClearFormatting: .Replacement.ClearFormatting .Text = "": .Replacement.Text = "" .MatchWildcards = False: .MatchFuzzy = False End With End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する