Word VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
289 / 316 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【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 お礼[未読]
【86】拡張メタファイルの貼り付け
質問  きみこ  - 04/3/23(火) 10:35 -
引用なし
パスワード
   文書に何枚も拡張メタファイル（ＥＭＦ）を貼り付ける作業を仕事でするのですが、
マクロで一度に貼り付ける際に、レイアウトをすべて背面したいのですが、
できるのでしょうか？
【87】Re:拡張メタファイルの貼り付け
回答  H. C. Shinopy  - 04/3/25(木) 0:06 -
引用なし
パスワード
   「拡張メタファイル」がどういうものか、
私は思い出せなくて・・・
確かにそういうのがあったような気がするのですが・・・
これは、Wordの旧バージョンの話ですか？
私が判る範囲内で答えさせて頂きます。

VBEの画面右上の質問ボックスで「ZOrder」を検索すると、
『ZOrderメソッド(Word)』のヘルプとして、
次の使用例が載っています。（但し、Word2002の話です。）
「・・・
次の使用例は、現在の文書に楕円を追加し、
文書内に少なくともほかの図形が 1 つでも存在する場合は、
追加した楕円を z 軸方向の最後から 2 番目の図形として配置します。

With ActiveDocument.Shapes.AddShape(Type:=msoShapeOval, Left:=100, _
　　Top:=100, Width:=100, Height:=300)
　　While .ZOrderPosition > 2
　　　　.ZOrder msoSendBackward
　　Wend
End With
・・・」

オートシェイプなどの図については、
「ZOrder」で移動先を指定できます。
御質問の「背面」が何を意味するのか
判然としませんが、
ここでは、既に挿入した図を総て
「文字列の後ろへ移動する」ということで、
下記のマクロを掲げることに致します。

Sub myShapeBehindText()
　Dim myShape As Shape
　'
　For Each myShape In ActiveDocument.Shapes
　　myShape.ZOrder msoSendBehindText
　Next myShape
End Sub
【88】Re:拡張メタファイルの貼り付け
お礼  きみこ  - 04/3/25(木) 14:41 -
引用なし
パスワード
   H. C. Shinopy さん回答ありがとうございました。
さっそく掲げていただいたマクロを試してみようと思います。
Wordもなにもかもまだ苦手なので、とっても助かりました。
試した結果もすぐにご連絡いたします。

ありがとうございました。
【89】Re:拡張メタファイルの貼り付け
質問  きみこ  - 04/4/14(水) 14:46 -
引用なし
パスワード
   ▼きみこ さん：
試してみたのですが、うまくいきませんでした。
下のマクロを組んで図を一度にいくつか貼り付けました。
そうすると文書の前面に貼り付けられます。背面（文字列の後ろへ移動）にするには
どうすればいいのでしょうか？
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
　 Sub myShapeBehindText()
　　　　Dim myShape As Shape
　　'
　　For Each myShape In ActiveDocument.Shapes
　　myShape.ZOrder msoSendBehindText
　　Next myShape
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
このマクロをどこかに入れればいいのでしょうか？
わたしはWord2000を使っています。
どなたか御教示いただけると幸いです。
よろしくお願い致します。


' Macro2 Macro
' 記録日 2004/04/14 記録者 KIMIKO
'
　　Selection.InlineShapes.AddPicture FileName:="C:\WORK\test\test1\EMF2\1.emf", _
　　　　 LinkToFile:=False, SaveWithDocument:=True
　　Selection.TypeBackspace
　　Selection.InlineShapes(1).Fill.Visible = msoFalse
　　Selection.InlineShapes(1).Fill.Transparency = 0#
　　Selection.InlineShapes(1).Line.Weight = 0.75
　　Selection.InlineShapes(1).Line.Transparency = 0#
　　Selection.InlineShapes(1).Line.Visible = msoFalse
　　Selection.InlineShapes(1).LockAspectRatio = msoTrue
　　Selection.InlineShapes(1).Height = 269.04
　　Selection.InlineShapes(1).Width = 486.75
　　Selection.InlineShapes(1).PictureFormat.Brightness = 0.5
　　Selection.InlineShapes(1).PictureFormat.Contrast = 0.5
　　Selection.InlineShapes(1).PictureFormat.ColorType = msoPictureAutomatic
　　Selection.InlineShapes(1).PictureFormat.CropLeft = 0#
　　Selection.InlineShapes(1).PictureFormat.CropRight = 0#
　　Selection.InlineShapes(1).PictureFormat.CropTop = 0#
　　Selection.MoveRight Unit:=wdCharacter, Count:=1
　　Selection.TypeParagraph
　　Selection.TypeParagraph
　　Selection.InsertBreak Type:=wdPageBreak


　　Selection.InlineShapes.AddPicture FileName:="C:\WORK\test\test1\EMF2\2.emf", _
　　　　 LinkToFile:=False, SaveWithDocument:=True
　　Selection.TypeBackspace
　　　　　・
　　　　　・
　　　　　・
　　　　　（ＥＭＦのファイル名を変えていくつか貼り付ける）
　　
End Sub
【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
【94】Re:拡張メタファイルの貼り付け
お礼  きみこ  - 04/4/30(金) 15:56 -
引用なし
パスワード
   ▼H. C. Shinopy さん：
ありがとうございます。
時間をかけてゆっくり試している最中です。
うまくいったらまたご連絡します♪
ほんとうにありがとうございます。
【100】Re:拡張メタファイルの貼り付け
質問  きみこ  - 04/5/27(木) 11:13 -
引用なし
パスワード
   H. C. Shinopy さん

先日はありがとうございました．
実はプログラムを今まで使ったりしたことがなかったので，
1文1文，意味を理解しながら，試しました．

先日教えてもらったのを参考に以下のマクロを作りました．

実行すると，「エラー13　型が一致しません」
となりました．これは，わたしのWordが2000で，H. C. Shinopyさんのが2002
だからなのでしょうか？

お忙しいことと思いますが，
もしよければ教えてください．ほんと，ひとつの話題でこんなにもしつこくて，すいません．．

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

Sub Macro2()
'
' Macro2 Macro
' 記録日 2004/05/24 記録者 TSUZAN
'
　　　　Selection.InlineShapes.AddPicture FileName:= _
　　　　"C:\WORK\SENC21\2004\matusima\EMF\W2.40.1.emf", LinkToFile:=False, _
　　　　SaveWithDocument:=True
　　Selection.TypeBackspace
　　Selection.InlineShapes(1).Fill.Visible = msoFalse
　　Selection.InlineShapes(1).Fill.Transparency = 0#
　　Selection.InlineShapes(1).Line.Weight = 0.75
　　Selection.InlineShapes(1).Line.Transparency = 0#
　　Selection.InlineShapes(1).Line.Visible = msoFalse
　　Selection.InlineShapes(1).LockAspectRatio = msoTrue
　　Selection.InlineShapes(1).Height = 379.45
　　Selection.InlineShapes(1).Width = 407.8
　　Selection.InlineShapes(1).PictureFormat.Brightness = 0.5
　　Selection.InlineShapes(1).PictureFormat.Contrast = 0.5
　　Selection.InlineShapes(1).PictureFormat.ColorType = msoPictureAutomatic
　　Selection.InlineShapes(1).PictureFormat.CropLeft = 0#
　　Selection.InlineShapes(1).PictureFormat.CropRight = 0#
　　Selection.InlineShapes(1).PictureFormat.CropTop = 0#
　　Selection.InlineShapes(1).PictureFormat.CropBottom = 0#
　　Selection.MoveRight Unit:=wdCharacter, Count:=1
　　Selection.TypeParagraph
　　Selection.TypeParagraph
　　Selection.InsertBreak Type:=wdPageBreak


　　Selection.InlineShapes.AddPicture FileName:= _
　　　　"C:\WORK\SENC21\2004\matusima\EMF\W2.40.2.emf", LinkToFile:=False, _
　　　　SaveWithDocument:=True
　　Selection.TypeBackspace
　　Selection.InlineShapes(1).Fill.Visible = msoFalse
　　Selection.InlineShapes(1).Fill.Transparency = 0#
　　Selection.InlineShapes(1).Line.Weight = 0.75
　　Selection.InlineShapes(1).Line.Transparency = 0#
　　Selection.InlineShapes(1).Line.Visible = msoFalse
　　Selection.InlineShapes(1).LockAspectRatio = msoTrue
　　Selection.InlineShapes(1).Height = 379.45
　　Selection.InlineShapes(1).Width = 407.8
　　Selection.InlineShapes(1).PictureFormat.Brightness = 0.5
　　Selection.InlineShapes(1).PictureFormat.Contrast = 0.5
　　Selection.InlineShapes(1).PictureFormat.ColorType = msoPictureAutomatic
　　Selection.InlineShapes(1).PictureFormat.CropLeft = 0#
　　Selection.InlineShapes(1).PictureFormat.CropRight = 0#
　　Selection.InlineShapes(1).PictureFormat.CropTop = 0#
　　Selection.InlineShapes(1).PictureFormat.CropBottom = 0#
　　Selection.MoveRight Unit:=wdCharacter, Count:=1
　　Selection.TypeParagraph
　　Selection.TypeParagraph
　 Selection.InsertBreak Type:=wdPageBreak
　　
　　Selection.InlineShapes.AddPicture FileName:= _
　　　　"C:\WORK\SENC21\2004\matusima\EMF\W2.40.3.emf", LinkToFile:=False, _
　　　　SaveWithDocument:=True
　　Selection.TypeBackspace
　　Selection.InlineShapes(1).Fill.Visible = msoFalse
　　Selection.InlineShapes(1).Fill.Transparency = 0#
　　Selection.InlineShapes(1).Line.Weight = 0.75
　　Selection.InlineShapes(1).Line.Transparency = 0#
　　Selection.InlineShapes(1).Line.Visible = msoFalse
　　Selection.InlineShapes(1).LockAspectRatio = msoTrue
　　Selection.InlineShapes(1).Height = 379.45
　　Selection.InlineShapes(1).Width = 407.8
　　Selection.InlineShapes(1).PictureFormat.Brightness = 0.5
　　Selection.InlineShapes(1).PictureFormat.Contrast = 0.5
　　Selection.InlineShapes(1).PictureFormat.ColorType = msoPictureAutomatic
　　Selection.InlineShapes(1).PictureFormat.CropLeft = 0#
　　Selection.InlineShapes(1).PictureFormat.CropRight = 0#
　　Selection.InlineShapes(1).PictureFormat.CropTop = 0#
　　Selection.InlineShapes(1).PictureFormat.CropBottom = 0#
　　Selection.MoveRight Unit:=wdCharacter, Count:=1
　　Selection.TypeParagraph
　　Selection.TypeParagraph
　 Selection.InsertBreak Type:=wdPageBreak
　　
　Call myShapeBehindText2
End Sub

Sub myShapeBehindText2()
'Dim my Shape As InlineShapes
Dim myCmmdBar As CommandBars
Dim myCtrl As CommandBarControl
Dim i As Integer
'

Set myCmmdBar = ActiveDocument.CommandBars("Picture")
Set myCtrl = myCmmBar.FindContro(ID:=1404)
'
For i = 0 To ActiveDocument.InlineShapes.Count - 1
ActiveDocument.InlineShapes.Item(i).Select
myCtrl.Controls(4).DescriptionText
' MsgBox myCtrl.Controls(4).DescripitionText '
Next i
'For Each myShape In ActiveDocument.InlineShapes
'myShape.ZOrder msoSendBehindText
'Set myCtrl = myCmmBar.FindControl(ID:=4000)
'myCtrl.Execute
'Next myShape

End Sub

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
【101】Re:拡張メタファイルの貼り付け
回答  H. C. Shinopy  - 04/5/27(木) 23:17 -
引用なし
パスワード
   myShapeBehindText2が異常終了したようで・・・
御手数をお掛けさせてしまったようです。
下記の通り修正しました。
誠に申し訳ないです。

「Dim myCmmdBar As CommandBars」を「Dim myCmmdBar As CommandBar」に、

「Set myCtrl = myCmmBar.FindContro(ID:=1404)」　は脱字、
「Set myCtrl = myCmmdBar.FindControl(ID:=1404)」に、

「myCtrl.Controls(4).DescriptionText」は「MsgBox myCtrl.Controls(4).DescripitionText」に一本化。
（これは処理内容確認のためで、異常がないなら、後でコメント行にして下さい。）

「For i = 0 To ActiveDocument.InlineShapes.Count - 1」は
「For i = ActiveDocument.InlineShapes.Count To 1 Step -1」に修正。
この部分は、私の不覚！
行内に配置された画像データは0からではなく1から始まるのでした。
（配列と勘違いしました。）
それと、画像を背面に移動する処理を、挿入した逆順に処理するようにしました。
行内に配置された画像データを背面に移動させるということは、
行内に配置された画像が削除されたのと同じ状態になるわけです。
・・・と言うことは、
画像データは、挿入処理後に（おそらく挿入が済んだ後で）、
時間的に挿入された順番に「InlineShape(1)・・・」のように自動で付番されるのですが、
1から順に処理すると、画像データ(1)が消滅して、
次の画像データ(2)が再び(1)から付番されることになり、
処理が変になるのでした！

「Selection.Collapse」を追加。これは画像データの選択の解除。

修正したマクロは以下の通り。（陳謝！）

Sub myShapeBehindText2()
　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 = ActiveDocument.InlineShapes.Count To 1 Step -1
　　ActiveDocument.InlineShapes.Item(i).Select　'　図の選択
　　myCtrl.Controls(4).Execute ' [テキストの折り返し]上から4番目[背面]
　　MsgBox myCtrl.Controls(4).DescriptionText ' 処理の説明
　Next i
　'
　Selection.Collapse
End Sub
【112】Re:拡張メタファイルの貼り付け
お礼  きみこ  - 04/6/22(火) 23:34 -
引用なし
パスワード
   H. C. Shinopy さん！ありがとうございます！成功しました！！
長い質問にもかかわらず、何度もお答えいただきありがとうございました。
ペコm(_ _;m)三(m;_ _)mペコ
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
289 / 316 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
207596
(SS)C-BOARD v3.8 is Free