ブック全体の置換に図形を含めるには？

質問

ブック全体の文字列を置換するＶＢＡを作ったのですが、
セルの文字だけではなく図形も対象にするにはどのように
したら良いのでしょうか？
よろしくお願いもうしあげます。

Sub WholeBookChange_Sub(FromX, ToX)
　　Dim s As Variant, flag As Boolean
　　Dim SheetMei As String
　　Application.StatusBar = "現在" & FromX & "から" & ToX & "へ変換中です。"
　　For Each s In Sheets
　　　　SheetMei = s.Name
　　　　Sheets(SheetMei).Select
　　　　Cells.Replace what:=FromX, Replacement:=ToX, LookAt:=xlPart, SearchOrder _
　　　　　　:=xlByRows, MatchCase:=False
　　Next s
End Sub

回答No.4

Wendy02 · ベストアンサー

こんばんは。

>使用しているExcel2003ではTextFrame2が認識されないようです。
実は、バージョンによって違うので、ここの部分に不安になりました。
Microsoft 側から、正式なマイグレーションが出ていないので、経験的に覚えていくしかありませんね。

Excel2000 ～Excel 2003 までですと、このようになります。
（両方で、チェック済みです）
なお、Replace 関数は、テキストコンペア・モードにしています。

Sub WholeBookChange_Sub(FromX As Variant, ToX As Variant)
　　Dim sh As Worksheet
　　Dim shp As Object
　　Dim s As String
　　For Each sh In ActiveWorkbook.Worksheets
　　　　For Each shp In sh.Shapes
　　　　　　With shp
　　　　　　　　s = ""
　　　　　　　　On Error Resume Next
　　　　　　　　s = .DrawingObject.Text
　　　　　　　　On Error GoTo 0
　　　　　　　　If s <> "" Then
　　　　　　　　　　.DrawingObject.Text = Replace(s, FromX, ToX, , , vbTextCompare)
　　　　　　　　End If
　　　　　　End With
　　　　Next shp
　　Next sh
End Sub

回答No.3

Wendy02

こんにちは。

Excel のバージョンはいくつですか？このご質問は、Excelのバージョンに影響されるはずです。

お礼

回答ありがとうございます。
Excel2000の（職場の）環境で動かします。
正月休み中は自宅のExcel2003で動作確認をやっています。

回答No.2

xls88

回答番号：No.1は、検証不足のようでした。

Sub test2()
　　Dim strtb As String
　　Dim i As Long
　　For i = 1 To ActiveSheet.Shapes.Count
　　　　With ActiveSheet.Shapes(i)
　　　　　　On Error Resume Next
　　　　　　strtb = .TextFrame2.TextRange.Text
　　　　　　On Error GoTo 0
　　　　　　If strtb <> "" Then
　　　　　　　　With .TextFrame2.TextRange
　　　　　　　　　　.Text = Replace(strtb, "あ", "Ａ")
　　　　　　　　End With
　　　　　　End If
　　　　End With
　　　　strtb = ""
　　Next
End Sub

お礼

回答ありがとうございます。
回答いただいたＶＢＡを試してみましたが、うまく行きません。
使用しているExcel2003ではTextFrame2が認識されないようです。
教えていただいたＶＢＡを参考にし、
strtb = .TextFrame2.TextRange.Textのところを
strtb = .TextFrame.Characters.Textに、
With .TextFrame2.TextRangeのところを
With .TextFrame.Charactersに変更してみたところ
まだすべて確認したわけではありませんが、一応動きました。

回答No.1

xls88

下記のようなコードで、図形のテキストが抽出できます。
抽出したテキストを「置換」にかければよいとおもいます。

Sub testテキスト抽出1()
　　Dim strtb As String
　　Dim i As Integer

　　For i = 1 To ActiveSheet.Shapes.Count
　　　　On Error Resume Next
　　　　With ActiveSheet.Shapes(i).TextEffect
　　　　　　If .Text <> "" Then
　　　　　　　　strtb = .Text
　　　　　　End If
　　　　End With
　　　　On Error GoTo 0
　　　　MsgBox strtb
　　Next
End Sub