|
あいや〜! 再度試行すると、うまくいきませんね。
「For Each myShape・・・〜Next MyShape」で図が選択できない上、
「myShape.ZOrder msoSendBehindText」が働かない!
クリップアートの図では問題なかったのに、
ファイルから挿入した図は別物扱いされるのかな?
手作業ではできるのにVBAではできない・・・
<<(@o@)>> {ムンク〜!]
いろいろやってみたのですが、
次のようなマクロになりました。
(こちらではemfファイがないので、手持ちのgifファイルで試行しました。)
背面処理は改めて作り変え、Macro2末尾で処理を実行するようしています。
苦肉の策でツールバー操作をVBAで処理するようにしたのですが、
これまた単純ではないようで、紆余曲折して動くようにしました。
こちらはWord2002で環境が異なるのですが、取り敢えず参考までに。
Sub Macro2()
' 記録日 2004/04/14 記録者 KIMIKO
'
Selection.InlineShapes.AddPicture FileName:="C:\Documents and Settings\User\My Documents\My Pictures\Zzz\shimane_01.gif", _
LinkToFile:=False, SaveWithDocument:=True
Selection.TypeBackspace
With Selection.InlineShapes(1)
.Fill.Visible = msoFalse
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.Transparency = 0#
.Line.Visible = msoFalse
.LockAspectRatio = msoTrue
.Height = 269.04
.Width = 486.75
.PictureFormat.Brightness = 0.5
.PictureFormat.Contrast = 0.5
.PictureFormat.ColorType = msoPictureAutomatic
.PictureFormat.CropLeft = 0#
.PictureFormat.CropRight = 0#
.PictureFormat.CropTop = 0#
End With
With Selection
.MoveRight Unit:=wdCharacter, Count:=1
.TypeParagraph
.TypeParagraph
.InsertBreak Type:=wdPageBreak
End With
' ====
Selection.InlineShapes.AddPicture FileName:="C:\Documents and Settings\User\My Documents\My Pictures\岡井路子.gif", _
LinkToFile:=False, SaveWithDocument:=True
Selection.TypeBackspace
With Selection.InlineShapes(1)
.Fill.Visible = msoFalse
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.Transparency = 0#
.Line.Visible = msoFalse
.LockAspectRatio = msoTrue
.Height = 269.04
.Width = 486.75
.PictureFormat.Brightness = 0.5
.PictureFormat.Contrast = 0.5
.PictureFormat.ColorType = msoPictureAutomatic
.PictureFormat.CropLeft = 0#
.PictureFormat.CropRight = 0#
.PictureFormat.CropTop = 0#
End With
With Selection
.MoveRight Unit:=wdCharacter, Count:=1
.TypeParagraph
.TypeParagraph
.InsertBreak Type:=wdPageBreak
End With
' ====
Call myShapeBehindText2
End Sub
Sub myShapeBehindText2()
' Dim myShape As InlineShapes
Dim myCmmdBar As CommandBar
Dim myCtrl As CommandBarControl
Dim i As Integer
'
Set myCmmdBar = ActiveDocument.CommandBars("Picture") ' [図]ツールバー
Set myCtrl = myCmmdBar.FindControl(ID:=1404) ' [テキストの折り返し]ボタン
'
For i = 0 To ActiveDocument.InlineShapes.Count - 1
ActiveDocument.InlineShapes.Item(i).Select ' 図の選択
myCtrl.Controls(4).Execute ' [テキストの折り返し]上から4番目[背面]
' MsgBox myCtrl.Controls(4).DescriptionText ' 処理の説明
Next i
' ↓なぜか動作しない
' For Each myShape In ActiveDocument.InlineShapes
' myShape.ZOrder msoSendBehindText ' ←↓なぜか動作しない
' Set myCtrl = myCmmdBar.FindControl(ID:=4000) ' [テキストの折り返し]-[背面]
' myCtrl.Execute ' ツールバー実行
' Next myShape
End Sub
|
|