• 締切済み

ワードマクロで指定範囲内の改行の数を調べたいと思っています。下記のよう

ワードマクロで指定範囲内の改行の数を調べたいと思っています。下記のような記述をしました。改行マークのない文を指定(selection)して実行すると、予定通り、n=0となるのですが、改行マークのある箇所を指定すると、文章全体の改行の数を調べてしまいます。 改行の意味で「vbCr」を使用しましたが、それが問題なのでしょうか?また、改行が入るとselectionが無効になるのでしょうか? どなたか教えてください。よろしくお願いします。 Sub test() Dim n As Integer Do While Selection.Find.Execute(findtext:=vbCr, Forward:=True) = True n = n + 1 Loop MsgBox (n) End Sub

みんなの回答

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

通常は、そのような改行の数は、MS-Wordで、カウントするようなことはしませんが、 今回の場合は、 >改行マークのない文を指定(selection)して実行すると、予定通り、n=0となるのですが、改行マークのある箇所を指定すると、文章全体の改行の数を調べてしまいます。 ドキュメントの検索からだと、Selection の終わりを認識しますが、VBAからだと、そのまま先に行ってしまいます。以下のようにすれば良いかと思います。それと、MS-WordのVBAは、あまり省略しないほうが良いようです。それと、MS-Wordには、Cr と Lf があるはずですが、今回は、あくまでも、1つにしました。 '// Sub CountCR()  Dim flgFound As Boolean  Dim iCount As Long  Dim rng As Range  Dim d As Long, e As Long    Set rng = Selection.Range  e = rng.End  iCount = 0  Do While e >= d   With rng.Find    .ClearFormatting    .Text = "^13"    .Wrap = wdFindStop    .MatchFuzzy = False '←ここと    .MatchWildcards = True '←ここが大事    .Execute   End With   d = rng.Start   flgFound = rng.Find.Found   If d > e Then Exit Do   If flgFound = True Then iCount = iCount + 1  Loop  MsgBox iCount & "個見つかりました。"  Set rng = Nothing End Sub

全文を見る
すると、全ての回答が全文表示されます。
  • myRange
  • ベストアンサー率71% (339/472)
回答No.1

Word VBAは●使ったことがない●ので考え方だけ。。。 選択範囲の中から改行文字を検索するのではなくて 選択範囲の中の改行文字を長さ0の文字列に置換して その文字数を選択範囲の文字数から引いてやるのはどうでしょう。 '------------------------------- Sub test()  Dim N As Long  N = Len(Selection) - Len(Replace(Selection, vbCr, ""))  MsgBox N End Sub '------------------------------ 以上です。

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • Wordのマクロを造りたいです。

    マクロの条件は以下のとおりです。 カタカナ⇒全角 英数字記号⇒半角 別途指定文字の変換 (例)   (1)⇒[1] 変換文字個数を表示 上記、4つの内容を1つのマクロ内で処理したいです。 お知恵をお願いします。 現在使用しているのは以下のマクロです。 Sub 電子納品のための変換プログラム() ' ' 電子納品のための変換プログラム Macro ' 記録日 2006/01/19 記録者 HP Customer ' With Selection.Find .MatchFuzzy = False End With t = 0 ' 英字 While Selection.Find.Execute(FindText:="[A-z]", _ Wrap:=wdFindContinue, MatchWildcards:=True) = True Forward = True MatchWildcards = True Selection.Range.CharacterWidth = wdWidthHalfWidth t = t + 1 Wend ' 数字 While Selection.Find.Execute(FindText:="[0-9]", _ Wrap:=wdFindContinue, MatchWildcards:=True) = True Forward = True MatchWildcards = True Selection.Range.CharacterWidth = wdWidthHalfWidth t = t + 1 Wend ' カナ文字 While Selection.Find.Execute(FindText:="[ヲ-ン][゛゜]", _ Wrap:=wdFindContinue, MatchWildcards:=True) = True MatchWildcards = True Selection.Range.CharacterWidth = wdWidthFullWidth t = t + 1 Wend While Selection.Find.Execute(FindText:="[ヲ-ン]", _ Wrap:=wdFindContinue, MatchWildcards:=True) = True MatchWildcards = True Selection.Range.CharacterWidth = wdWidthFullWidth t = t + 1 Wend While Selection.Find.Execute(FindText:="[。-゜]", _ Wrap:=wdFindContinue, MatchWildcards:=True) = True MatchWildcards = True Selection.Range.CharacterWidth = wdWidthFullWidth t = t + 1 Wend t = CStr(t) Msg = t + "件の変換がありました。" MsgBox (Msg) End Sub

  • ワードで選択範囲だけの改行を削除するマクロ

    こんにちは いつもお世話になっています ワード2010で、選択範囲だけの部分の改行を削除するマクロを記録マクロで作ったのですが、選択部以外もすべて改行してしまいます。どこがいけないのでしょうか。あるいは、操作の仕方でしょうか。以前は使えていたと思うのですが、仕様が変わったのでしょうか。 任意の範囲を選択しておいて、記録を開始しました。 よろしくお願いします。 Sub Macro1() ' ' Macro1 Macro ' ' Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "^p" .Replacement.Text = "" .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = False End With Selection.Find.Execute Replace:=wdReplaceAll End Sub ネット上で見つけた以下のマクロでもすべての改行が削除されます。 http://okwave.jp/qa/q960285.html Sub Macro14() Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "^p" .Replacement.Text = " " End With Selection.Find.Execute Replace:=wdReplaceAll End Sub

  • wordマクロで検索⇒フォント変更したいが、結果がとびとびになります。

    MSwordのマクロについてです。マクロはど素人です。 「数式に使うa,b,n,p,q,r,t,u,v,w,x,y,zの文字を検索して、CMUserifというフォントに変え、サイズを2pt大きくする」 つもりで、以下のマクロを見よう見まねで作って実行したところ、うまく変更される文字とされない文字が混在してしまいます。 これはどのような理由によるもので、また、どのようにマクロを訂正すればよいのでしょうか。 --- Sub 数式用フォントに変更() Selection.StartOf wdStory With Selection.Find Do While .Execute(FindText:=\"[a-bn-np-rt-z]\", Forward:=True, Format:=False, MatchWildcards:=True, MatchSoundsLike:=False) = True With Selection Selection.Find.Execute Selection.Font.Name = \"CMU Serif\" Selection.Font.Size = Selection.Font.Size + 2 Selection.Find.ClearFormatting End With Loop End With End

  • 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

  • MS Wordのマクロで自動改ページする方法

    xabcxdefgxhijk・・・ のように並んだ文字列を xabc(改ページ) xdefg(改ページ) xhijk・・・ のように,xの位置で自動的に改ページしたい。 ------------------------------------------ 上記の動作を実行するためのマクロを見よう見まねで 以下に示すように作成したのですが,成功したり成功しなかったりします。 原因が分かる方ご指摘ご修正いただけるとありがたいです。 (Wordのマクロは今回始めて作成する全くの初心者です。) WordのバージョンはOffice2003です。 よろしくお願いいたします。 ------------------------------------------ Sub kaipage() Dim blnFound As Boolean Dim rngContent As Range Dim intCount As Integer blnFound = True Set rngContent = ActiveDocument.Content intCount = 0 Do While blnFound = True With rngContent.Find .ClearFormatting .Wrap = wdFindContinue .Text = "x" .Replacement.Text = "$" .Execute Replace:=wdReplaceOne, Forward:=True End With Selection.Find.Execute Selection.InsertBreak Type:=wdPageBreak blnFound = rngContent.Find.Found If blnFound = True Then intCount = intCount + 1 Loop MsgBox (intCount & "個見つかりました。") End Sub

  • Wordマクロ

    Wordでワイルドカードを使った置換マクロを作ったのですが、 「MatchWildcardsとMatchSoundsLike、MatchAllWordForms、MatchFuzzyは、同時にTrueに設定することはできません。」 というエラーが出てしまいます。 MatchSoundsLike、MatchAllWordForms、MatchFuzzyは、 ソースに書いてないしTrueにもしていません。 どこが悪いのでしょうか? 以下がソースファイルです、よろしくお願いいたします。 Sub substitute() ' Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "[!a-f]{1,}" .Replacement.Text = "@" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .MatchFuzzy = False End With Selection.Find.Execute Replace:=wdReplaceAll End Sub

  • word2007 マクロ

    下記マクロは蛍光ペンの箇所を括弧と空欄で書き換え、穴あき問題にするマクロです。 これを、文字数の分だけ、空欄をつくるにはどうすればいいのか? また、蛍光ペンではなく、赤文字を括弧と空欄で書き換えるにはどうすればいいのか、 教えて頂けたら幸いです。 Sub Macro7() Selection.HomeKey wdStory '文章の最初をカーソル移動 p1: Selection.Find.ClearFormatting Selection.Find.Highlight = True '蛍光ペンを問題にする With Selection.Find .Text = "" '文字は問題にしない .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = True End With Selection.Find.Execute '検索実行 If Selection = m Then Exit Sub '同じところを繰り返し見つけ出したら終わる x = "(        )" 'カッコで囲む語句を作成(蛍光ペンなし) m = x '終わり判定のため保存 Selection.Delete '一旦消して Selection.InsertAfter x 'カッコつきを挿入。いわば置換 GoTo p1 End Sub

  • word2007 マクロ

    下記マクロは蛍光ペン部分を消して、その文字数分にアンダーラインを引くマクロになります これを改造して、赤文字を消して、その文字数分を空欄にしたいのです。 ですが、wdColorRedの入れ方が分かりません。ご教授お願いします。 Sub Problem() '蛍光ペン部分を消して、アンダーラインを引く Selection.Find.ClearFormatting Selection.Find.Highlight = True Selection.Find.Replacement.ClearFormatting Selection.Find.Replacement.Highlight = False With Selection.Find.Replacement.Font .Underline = wdUnderlineSingle .StrikeThrough = False .DoubleStrikeThrough = False .Outline = False .Shadow = False .Hidden = False .AllCaps = False .Superscript = False .Subscript = False End With With Selection.Find .Text = "*" .Replacement.Text = " ^z" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchFuzzy = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll End Sub

  • ワードでマクロがうまくいきません。

    よろしくお願いします。 マクロの知識はほとんどないのですが、 「マクロの記録」の機能を使い、ワードで 「スペースを探し出し、そのスペースにアンダーラインを引く。」 ために、 -------------------- 編集ー置換ー 検索する文字列にスペースをタイプ、 置換後の文字列にスペースをタイプ、 オプションの書式で、フォント、下線、一重下線 すべて置換 -------------------- マクロの記録を選択した後、上のように作業しました。 そしてマクロの記録をとめました。 マクロの記録中の操作では、思い通りに置換されるのですが、 次にそのマクロを作動させると、なにもおこりません。 なにか変な操作をしたのか、と五度くらい試したのですが、 やはり動きません。 中身は、↓のようでした。 -------------------- Sub Macro2() ' Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = " " .Replacement.Text = " " .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = True End With Selection.Find.Execute Replace:=wdReplaceAll 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

このQ&Aのポイント
  • LaVie S LS350/RSWのエクスプローラー表示が遅くなった。
  • Windows8.1のPCのリフレッシュを行った後、エクスプローラーの起動に時間がかかるようになった。
  • 対処方法を教えてください。
回答を見る

専門家に質問してみよう