Word VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム

23 / 308 ﾂﾘｰ

←次へ　｜　前へ→

▼

【814】Word VBAで指定個所に下線 マナ 16/10/30(日) 13:14

【815】Re:Word VBAで指定個所に下線 マナ 16/10/30(日) 14:01


	【814】Word VBAで指定個所に下線

マナ - 16/10/30(日) 13:14 -


	引用なし

	パスワード

よその掲示板であったWordに関する質問です。
向こうはExcel VBAの掲示板なので、
Excelと関係ないWordのやりとりすることに
抵抗がありましたので、この場をお借りまします。

Word VBAで指定個所に下線
excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=178971&rev=0

質問はこんな感じ：
１）段落が★で始まるとき、
２）□の次の文字から段落末（改行）まで
３）下線を引く

下記のマクロでは、一度下線を引いてから、
不要箇所の下線をけしているので無駄に思える。
最初から、目的の箇所のみに下線を引きたい。

ちょっと編集していますが、
概ねこんな内容の質問です。

Sub 下線を引く1()
　　Dim r As Range
　　Dim myKW As String
　　Dim myKW2 As String

　　myKW = "<★*^13"
　　myKW2 = "<★*□"

　　Set r = ActiveDocument.Range(0, 0)
　
　　With r.Find
　　　　.Text = myKW
　　　　.MatchWildcards = True
　　End With
　　With r
　　　　Do While .Find.Execute = True
　　　　　　.Underline = wdUnderlineThick '太下線
　　　　　　.Collapse direction:=wdCollapseEnd
　　　　Loop
　　End With
　　
　　Set r = ActiveDocument.Range(0, 0)
　　
　　With r.Find
　　　　.Text = myKW2
　　　　.MatchWildcards = True
　　End With
　　With r
　　　　Do While .Find.Execute = True
　　　　　　.Underline = wdUnderlineNone '下線なし
　　　　　　.Collapse direction:=wdCollapseEnd
　　　　Loop
　　End With

End Sub


	【815】Re:Word VBAで指定個所に下線

マナ - 16/10/30(日) 14:01 -


	引用なし

	パスワード

シンプルでわかりやすいし、今の方法がよいのでは
というのが、わたしの考えです。

ということで、ほとんど同じですが、
置換を一括で行うように書き換えただけの案を提示。

Sub 下線を引く2()
　　Dim r As Range
　　Dim myKW As String
　　Dim myKW2 As String

　　myKW = "<★*^13"
　　myKW2 = "<★*□"

　　Set r = ActiveDocument.Range
　
　　With r.Find
　　　　.MatchWildcards = True
　　　　.Text = myKW
　　　　.Replacement.Font.Underline = wdUnderlineThick
　　　　.Execute Replace:=wdReplaceAll
　　　　.Text = myKW2
　　　　.Replacement.Font.Underline = wdUnderlineNone
　　　　.Execute Replace:=wdReplaceAll
　　End With
　　
End Sub

該当箇所のみ下線を引こうとすると
コードがわかりにくくなるしメリットないような気がします。

Sub 下線を引く3()
　　Dim r As Range
　　Dim myKW As String

　　myKW = "□*^13"

　　Set r = ActiveDocument.Range

　　With r.Find
　　　　.MatchWildcards = True
　　　　.Text = myKW
　　　　Do While .Execute
　　　　　　If r.Paragraphs(1).Range.Characters(1) = "★" Then
　　　　　　　　r.MoveStart wdCharacter
　　　　　　　　r.Underline = wdUnderlineThick
　　　　　　End If
　　　　　　r.Collapse wdCollapseEnd
　　　　Loop

　　End With

End Sub

Sub 下線を引く4()
　　Dim r As Range
　　Dim myKW As String, repWd As String
　　Dim myKW2 As String, repWd2 As String

　　myKW = "<(★*□)(*)^13"
　　repWd = "\1〒\2〒^p"
　　
　　myKW2 = "〒(*)〒"
　　repWd2 = "\1"

　　Set r = ActiveDocument.Range
　
　　With r.Find
　　　　.MatchWildcards = True
　　　　.Text = myKW
　　　　.Replacement.Text = repWd
　　　　.Execute Replace:=wdReplaceAll
　　　　.Text = myKW2
　　　　.Replacement.Text = repWd2
　　　　.Replacement.Font.Underline = wdUnderlineThick
　　　　.Execute Replace:=wdReplaceAll
　　End With
　　
End Sub


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム

23 / 308 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free