Excel VBA質問箱 IV

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

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


51357 / 76732 ←次へ | 前へ→

【30245】Re:抽出後のCellの文字色変更と復活
回答  micnak  - 05/10/24(月) 5:16 -

引用なし
パスワード
   >ows.Activate
>oTBox.Select
>strWk = Replace(Selection.Characters.Text, _
>strFind, strRep, 1, -1, vbTextCompare)
>If strWk = strRep Then
>oTBox.DrawingObject.Characters.Font.ColorIndex = 5 '青にする
>End If

の部分を独立させたプロシージャを作ってみました。
'#####オートシェイプ内の置換処理(置換後⇒青)をする#####
Sub ReplaceAndColorInShape(Target As Shape, strFind As String, strReplace As String)
 
 'テキストを持たないオートシェープなら処理を終了する。
 On Error GoTo TextGetError_
 
 Dim ShapeText As String
 ShapeText = Target.TextFrame.Characters.Text
 On Error GoTo 0
 
 Dim ReplaceResult As String
 ReplaceResult = Replace(ShapeText, strFind, strReplace, 1, -1, vbTextCompare)
 If ReplaceResult <> ShapeText Then
  Target.TextFrame.Characters.Text = ReplaceResult
  Target.DrawingObject.Characters.Font.ColorIndex = 5 '青にする
 End If
 
 Exit Sub

TextGetError_:
End Sub

エラー処理を加えたりしたので元のコードより長くなってしまいましたが、こうやってプロシージャとして独立させてやると以下のようなテストプロシージャを使ったりしながら、動作のおかしい部分に集中してデバッグが出来ます。

'ReplaceAndColorInShapeのテスト用プロシージャ
Sub testReplaceAndColorInShape()
 Dim s As Shape
 For Each s In Sheet1.Shapes
  ReplaceAndColorInShape s, "検索文字列", "置換結果"
 Next
End Sub

0 hits

【30213】オートシェイプ置換後⇒色変えについて けろりん 05/10/21(金) 23:56 質問
【30245】Re:抽出後のCellの文字色変更と復活 micnak 05/10/24(月) 5:16 回答
【30545】Re:抽出後のCellの文字色変更と復活 MS−07B 05/10/30(日) 0:50 お礼

51357 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free