- VBAなんでも質問スレ
723 ：717[sage]：2014/07/08(火) 19:33:18.41 ID:JOUr1Q8P - >>722
Wordにあるオブジェクトの情報は717に記載した通りですが、
構造を理解していただくためにサンプルを用意しました。
ですが、アップローダにファイルを置いたことがないため、
オススメのアップローダを教えていただけると幸いです
>>721
コードは、717のコードのキャンバス部分の処理を若干手直しした、次のものを使っています。
動くかどうかの実験ですので、手入力などの処理ではなく、全てコード内に記述してあります。
※実際の作業では特定のテキストボックスのテキストの置換で足りるのですが、
その特定のテキストボックスを指定する知識がないため、オブジェクトを総ざらいしています。
（コードは次のレスで）
| - VBAなんでも質問スレ
724 ：717[sage]：2014/07/08(火) 19:37:06.95 ID:JOUr1Q8P - （723の続き）
Sub ReplaceString()
Dim appWD As Object, WDfile As Object
Dim ShapeObj As Object, GrpObj As Object, CvsObj As Object
Const SearchStr As String = "＠＠＠"
Const ReplaceStr As String = "2013"
Set appWD = CreateObject("Word.Application")
Set WDfile = appWD.Documents.Open("C:＼hoge＼fuga＼717document.doc")
appWD.Visible = True
For Each ShapeObj In WDfile.Shapes
If ShapeObj.Type = msoTextBox Then
ReplaceShapeText ShapeObj, SearchStr, ReplaceStr
ElseIf ShapeObj.Type = msoGroup Then
For Each GrpObj In ShapeObj.GroupItems
If GrpObj.Type = msoTextBox Then
ReplaceShapeText GrpObj, SearchStr, ReplaceStr
End If
Next GrpObj
（if文の途中ですが、改行が多いと怒られるので続く）
| - VBAなんでも質問スレ
725 ：717[sage]：2014/07/08(火) 19:37:46.21 ID:JOUr1Q8P - （724の続き）
ElseIf ShapeObj.Type = msoCanvas Then
For Each CvsObj In ShapeObj.CanvasItems
If CvsObj.Type = msoTextBox Then
ReplaceShapeText CvsObj, SearchStr, ReplaceStr
ElseIf CvsObj.Type = msoGroup Then
For Each GrpObj In ShapeObj.GroupItems
If GrpObj.Type = msoTextBox Then
ReplaceShapeText GrpObj, SearchStr, ReplaceStr
End If
Next GrpObj
End If
Next CvsObj
End If
Next ShapeObj
appWD.Quit
Set appWD = Nothing
End Sub
Private Sub ReplaceShapeText(Shp As Object, SrcText As String, DestText As String)
If Shp.TextFrame.HasText Then
With Shp.TextFrame.TextRange.Find
.ClearFormatting
.Forward = True
.Text = SrcText
.Replacement.Text = DestText
.Execute Replace:=wdReplaceAll
End With
End If
End Sub
|
|