'----------------------------------------------------------------------------------------- Public Sub Replace_RaS(Tgt_Text As String, Rep_Text As String, Optional Mode As Long) '==================================== ' 選んだワークシートの全置換※シェイプ内テキストを含む '==================================== Dim WSs As Object, WS As Worksheet Dim Rng As Range Dim shps As Shapes, shp As Shape Dim i As Long, wkStr As String
On Error GoTo Err_Replace_RaS
i = 0 If Mode = 0 Then Mode = xlFormulas
Set WSs = ActiveWindow.SelectedSheets Application.ScreenUpdating = False
For Each WS In WSs
' 普通に置換 Set Rng = WS.Cells.Find(Tgt_Text, , Mode) Do Until Rng Is Nothing Select Case Mode Case xlFormulas Rng.Formula = Replace(Rng.Formula, Tgt_Text, Rep_Text) Case xlValues Rng.Value = Replace(Rng.Value, Tgt_Text, Rep_Text) Case xlComments Rng.Comment = Replace(Rng.Comment, Tgt_Text, Rep_Text) Case Else Rng.Value = Replace(Rng.Value, Tgt_Text, Rep_Text) End Select
i = i + 1 Set Rng = WS.Cells.Find(Tgt_Text, Rng, Mode) Loop
Set Rng = Nothing Set shps = WS.Shapes
On Error GoTo Non_Err_CK
For Each shp In shps If InStr(shp.TextFrame.Characters.Caption, Tgt_Text) > 0 Then wkStr = shp.TextFrame.Characters.Caption shp.TextFrame.Characters.Caption = Replace(wkStr, Tgt_Text, Rep_Text) i = i + 1 End If Skip_Shp: Next
Set shp = Nothing Set shps = Nothing
On Error GoTo Err_Replace_RaS Next
Application.ScreenUpdating = True
MsgBox i & " 件置換しました。"
Exit Sub Non_Err_CK: Select Case Err.Number Case 13 Resume Skip_Shp End Select
Err_Replace_RaS: Debug.Print Err.Number & " " & Err.Description Resume Next End Sub '-----------------------------------------------------------------------------------------
余談で発見したTips。Variant型のOptionalが省略されている時に、規定値を設定したい時 (↑の『If Mode = 0 Then Mode = xlFormulas』のModeがLong型じゃなくてVariant型だったら)