Word VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


800 / 886 ←次へ | 前へ→

【90】Re:拡張メタファイルの貼り付け
回答  H. C. Shinopy  - 04/4/17(土) 22:17 -

引用なし
パスワード
   あいや〜! 再度試行すると、うまくいきませんね。
「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

2,721 hits

【86】拡張メタファイルの貼り付け きみこ 04/3/23(火) 10:35 質問
【87】Re:拡張メタファイルの貼り付け H. C. Shinopy 04/3/25(木) 0:06 回答
【88】Re:拡張メタファイルの貼り付け きみこ 04/3/25(木) 14:41 お礼
【89】Re:拡張メタファイルの貼り付け きみこ 04/4/14(水) 14:46 質問
【90】Re:拡張メタファイルの貼り付け H. C. Shinopy 04/4/17(土) 22:17 回答
【94】Re:拡張メタファイルの貼り付け きみこ 04/4/30(金) 15:56 お礼
【100】Re:拡張メタファイルの貼り付け きみこ 04/5/27(木) 11:13 質問
【101】Re:拡張メタファイルの貼り付け H. C. Shinopy 04/5/27(木) 23:17 回答
【112】Re:拡張メタファイルの貼り付け きみこ 04/6/22(火) 23:34 お礼

800 / 886 ←次へ | 前へ→
ページ:  ┃  記事番号:
207142
(SS)C-BOARD v3.8 is Free