Word VBA質問箱 IV

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

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


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

96 / 886

←次へ　｜　前へ→


	【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

314 hits

▼

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