| |
「同じ配置で、１ページ内に収めたい」とのことですが、
Word文書のあちこちにある全ページの画像を１つの画像にするということですか？
いろいろな条件付きで、Microsoft Publisher連携での半自動処理になりますが、
それで宜しければ・・・
Publisherの画像データを右クリックして
[図として保存]で保存できるのを利用します。
（PowerPointにも同じ機能があるのですが、
スライドからはみ出た部分が削られてしまうので、この案はボツ。
Excelのグラフ機能にも[図として保存]がありますが、
2ページ目以降のデータを処理しませんので、これもボツです。）
それから最新版であるWord2003・Publisher2003のVBAではどうなのか、
情報が欲しいところですが・・・
余り判らない点もあり、
結果として酔っ払いが作ったようなマクロになりました。
・画像データは、[テキストの折り返し]で[行内]に配置されているものとします。
（行内が指定されていないと、なぜか画像データとして処理されません。）
・処理の途中で「形式を選択して貼り付け」ダイアログボックスが表示されるので、
（Publisher VBAでは、形式を指定して貼り付けをするメソッドがないのか？）
[貼り付け]ラジオボタン・[新しい表]を指定して、[OK]をクリックします。
・処理が済んだ後、次の手作業が必要です。
Publisher文書上に画像データがテキストボックス内の表として
貼り付けされているので、手作業で画像データの横幅を確認します。
（元のWord文書上の画像が単に縦1列に配置されていただけの場合は、確認不要です。）
画像の右側部分が隠れている場合は、マウスでテキストボックスと中にある表を右へ広げます。
画像データを右クリックして、[図として保存]を選択し、
ファイル名とファイル形式を指定して保存します。
Sub myPicPasteSemiAuto()
Rem 文書全体を表として（文字列・画像も含めて）
Rem Publisherへ貼り付けする半自動処理
Rem *----*----* *----*----* *----*----* *----*----*
Rem 参照設定：Microsoft Publisher 10.0 Object Library
Rem *----*----* *----*----* *----*----* *----*----*
Dim myShape As InlineShape
Dim myPublisher As Publisher.Application
Dim myWidthMax As Long
'
Dim myCmmdBar As CommandBar
Dim myCtrl As CommandBarControl
'
myWidthMax = -1
For Each myShape In ActiveDocument.InlineShapes
If myShape.Width > myWidthMax Then
myWidthMax = myShape.Width
End If
Next myShape
If myWidthMax = -1 Then
MsgBox "行内に配置した画像データなし"
Exit Sub
End If
'
Selection.WholeStory
Selection.Copy
Selection.Collapse
'
Set myPublisher = CreateObject("Publisher.Application")
myPublisher.NewDocument
myPublisher.ActiveWindow.Visible = True
'
Set myCmmdBar = myPublisher.Application.CommandBars("Edit") ' 編集
Set myCtrl = myCmmdBar.FindControl(ID:=755) ' 形式を指定して貼り付け
myCtrl.Execute
Rem [新しい表]を指定。
'
Rem MsgBox myPublisher.Selection.ShapeRange.Width ' 試行用
Rem myPublisher.Selection.ShapeRange.Item(1).Width = 300 ' 試行用
'
If myPublisher.Selection.ShapeRange.Item(1).HasTable = msoTrue Then
myPublisher.Selection.ShapeRange.Item(1).Table.Columns.Item(1).Width = myWidthMax
End If
'
Set myShape = Nothing
Set myPublisher = Nothing
Set myCmmdBar = Nothing
Set myCtrl = Nothing
End Sub ' myPicPasteSemiAuto
|
|
H. C. Shinopy
- 04/5/27(木) 23:46 -
