プロが教える店舗&オフィスのセキュリティ対策術

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

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

A 回答 (4件)

こんばんは。



>使用している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
    • good
    • 0

こんにちは。



Excel のバージョンはいくつですか?このご質問は、Excelのバージョンに影響されるはずです。
    • good
    • 0
この回答へのお礼

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

お礼日時:2009/01/01 20:04

回答番号: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, "あ", "A")
        End With
      End If
    End With
    strtb = ""
  Next
End Sub
    • good
    • 0
この回答へのお礼

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

お礼日時:2009/01/01 20:01

下記のようなコードで、図形のテキストが抽出できます。


抽出したテキストを「置換」にかければよいとおもいます。

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
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!