ワードマクロについて

質問

ワードマクロについて

ＭＳ　ＷＯＲＤ　２００３ファイル中の「図の書式
設定」の「高さ」および「幅」を、インプットボックス
で入力した数値（％）で拡大・縮小するために、
下記マクロを作成しました。

　下記マクロは、ケミドローで作成した化学式を
ＷＯＲＤ文書にコピー・ペーストした図に対して
は正常に機能します。

　しかし、特許・実用新案公報ＤＢ
（http://www.ipdl.inpit.go.jp/Tokujitu/tjsogodb.ipdl?N0000=101）
で検索した特許文献を、ＷＯＲＤ文書にコピー・ペースト
した場合、その図に対してマクロを実行すると、「高さ」
および「幅」が入力値とは異なるというバグがあります。

　例えば、上記サイトで検索した「特開２０１０－１」を
ＷＯＲＤファイルにコピー・ペーストした後、【図１】
に対して、このマクロで「３０」（％）を入力すると、
「高さ」および「幅」に、それぞれ「１０％」および
「２２％」が入力されます。

　このバグの原因および解決策をご教示下さい
ますようお願いします。

Sub Size_Each_Image()
' 選択イメージのサイズ変更。
'
' 現在のＩＭＥの状態を格納する場所を宣言
Dim sinIME As Single
' インプットボックスで入力された％の格納場所を宣言
Dim varX As Variant
'
' 選択箇所が行内図でない場合、終了。
If Selection.Type <> wdSelectionInlineShape Then End
'
' 現在のＩＭＥの状態を格納し、日本語入力をＯＦＦにする
With ActiveWindow
sinIME = .IMEMode
.IMEMode = wdIMEModeOff
End With
'
' インプットボックスでサイズ入力。
varX = InputBox("選択イメージのサイズ(％)は？", "選択イメージのサイズ")
' キャンセルされた場合、日本語入力を元に戻して終了。
If varX = "" Then
ActiveWindow.IMEMode = sinIME
End
End If
'
' サイズ入力
With Selection.InlineShapes(1)
.ScaleHeight = varX
.ScaleWidth = varX
End With
'
' ＩＭＥを元に戻す
ActiveWindow.IMEMode = sinIME
'
End Sub

回答No.5

Wendy02 · ベストアンサー

>WORD 2003ではコピー・ペーストできますが、WORD 2007ではコピー・ペーストできなかったという経験があります。

私の場合は、一旦、メモリ枠を手動で確保しないと、継続的にCtrl + C のClick コピーでは取れません。私の場合は、二重にセキュリティが掛かっていたはずですから、いきなりには出来ません。

また、おっしゃる現象は、クリップボードにいれたものを、BitMap 変換して貼り付けたものは、物理的なサイズは存在し、何らかの方法で取り出すことは可能かもしれませんが、VBAから取れませんので、いろいろ調べてみましたが、ScaleHeight やScaleWidth からでは、Original Size から割合は設定出来ません。以上が、私が調べた結果です。

図は、ダウンローダで一括ダウンロード出来ますが、問題点は、ファイル名は一律ですから、どれがどれだか分からなくなることです。そこで新たに元の図に対する考え方の違う、Shape に対する処理をするマクロを作りました。

以下のマクロの使い方：
・IEの図を右クリックでコピーして、クリップボードに入れます。
・ワード上で右クリックして、「図の割付」というメニューがありますから、クリックすると、「形式を選択して貼付け」ダイアログが出てきます。
・貼り付ける形式--[ビットマップ(DIB)]を選択して、[OK]をクリックします。(重要）
・貼り付けると、パーセントの問い合わせが出てきてきます。
・後は、1以上の数字を入れてください。
(貼り付けるとクリップボードは空になっているはずです。）
・既に貼り付けてある図に対しては、図を選択してから、右クリックして、「図の割付」をクリックすれば、そのまま実行出来ます。
(なお、図がクリップボードに入っていずに、テキストが入っている場合は、マクロは起動せずに、単に、文字が貼り付けされるだけです）

'//'標準モジュールのみ(出来れば、Normal.dot が良い。ただし、Word 2003 まで）
Public Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long

Public Const CF_TEXT As Long = 1
Public Const CF_BITMAP As Long = 2
Sub AutoOpen()
　On Error Resume Next
　With Application.CommandBars("TEXT")
　　.Controls("図の割付").Delete
　End With
　With Application.CommandBars("Inline Picture")
　　.Controls("図の割付").Delete
　End With
　On Error GoTo 0
　With Application.CommandBars("TEXT").Controls.Add _
　　(Type:=msoControlButton, Temporary:=True)
　　.BeginGroup = False
　　.Caption = "図の割付"
　　.OnAction = "PastePicture"
　End With
　With Application.CommandBars("Inline Picture").Controls.Add _
　　(Type:=msoControlButton, Temporary:=True)
　　.BeginGroup = False
　　.Caption = "図の割付"
　　.OnAction = "PastePicture"
　End With
　On Error GoTo 0
End Sub

'//次へ(同じモジュール）

お礼

Wendy02さん、詳しく情報を調べて下さり、本当にありがとうございます。

　それに加えて、別の考え方のマクロを作成して下さり、感謝しています。

　作成下さったマクロは、Functionプロシージャなど、プロの
プログラマーが使用される知識がちりばめられており、感動しています。

　ワードマクロは事例が少ないため、大変参考になります。

　なお、作成下さったマクロは、素人の私には高度すぎて現時点
で理解できませんが、コツコツ勉強して、今後の参考にさせて頂きます。

　どうもありがとうございました。

回答No.6

Wendy02

'//5の続き
Private Sub PastePicture()
　Dim x As Single
　Dim intIME As Integer
　Dim i As Long
　On Error Resume Next
　If IsClipboardFormatAvailable(CF_BITMAP) > 0 Then
　　Application.Dialogs(wdDialogEditPasteSpecial).Show
　ElseIf IsClipboardFormatAvailable(CF_TEXT) > 0 Then
　　If Selection.Type <> wdSelectionInlineShape Then
　　　 Selection.PasteAndFormat wdPasteDefault
　　Exit Sub
　　End If
　End If
　i = ActiveDocument.Shapes.Count
　ActiveDocument.Shapes(i).Select
　With ActiveWindow
　　intIME = .IMEMode
　　.IMEMode = wdIMEModeOff
　End With
　x = InputBox("選択イメージのサイズ(％)は？", "選択イメージのサイズ")
　If Val(x) <= 0 Then
　　Exit Sub
　ElseIf Val(x) < 1 Then
　　MsgBox "1　以上の数字を入力してください。", vbExclamation
　　Exit Sub
　End If
　With Selection
　　If .Type = wdSelectionShape Then
　　　.ShapeRange.ScaleHeight x / 100, msoTrue
　　　.ShapeRange.ScaleWidth x / 100, msoTrue
　　　.ShapeRange.ConvertToInlineShape
　　　.Range.Collapse Direction:=wdCollapseEnd
　　　.Range.InsertAfter Text:=vbCrLf
　　　 Call ClipboardClear
　　ElseIf .Type = wdSelectionInlineShape Then
　　　If .InlineShapes.Count > 0 Then
　　　　.InlineShapes(1).ScaleHeight = x
　　　　.InlineShapes(1).ScaleWidth = x
　　　　Call ClipboardClear
　　　Else
　　　　MsgBox "設定に失敗しました。", vbExclamation
　　　End If
　　End If
　End With
　With ActiveWindow
　　.IMEMode = intIME
　End With
　On Error GoTo 0
End Sub

Sub Auto_Close()
　　On Error Resume Next
　　With Application.CommandBars("TEXT")
　　　　.Controls("図の割付").Delete
　　End With
　　With Application.CommandBars("Inline Picture")
　　　　.Controls("図の割付").Delete
　　End With
　 On Error GoTo 0
End Sub
Private Function ClipboardClear() As Boolean
'クリップボードクリア
Dim ret As Long
　　ClipboardClear = False
　　If OpenClipboard(0) = 0 Then Exit Function
　　If EmptyClipboard() = 0 Then
　　　　ret = CloseClipboard()
　　　　Exit Function
　　End If
　　If CloseClipboard() = 0 Then Exit Function
　　ClipboardClear = True
End Function

'Word 2007 は、私の環境では、設定が出来ません。

お礼

Wendy02さん、丁寧なご教示、本当に感謝しています。

回答No.4

mimeu

#2 です。ご参考までに補足します。

> 「補足」の（１）～（３）に記載しましたように、
> 残念ながら、正常に動いていないようです。

言葉が足りませんでしたが、私もご呈示のマクロを使って
特開２０１０－１をサイズ変更してみたうえ、
debug.print Selection.InlineShapes(1).ScaleHeight; Selection.InlineShapes(1).ScaleWidth
により結果を確認しましたが、正常に動いておりました。

ただ違うのは、
(1) 私の環境は Excel 2007 であること
(2) 私のテストはミリメートル単位ではなく、ピクセル単位でしたこと
　　（関係ないと思いますけど・・・）
(3) 私の環境（IE 8.0.7600) では特許の画像をコピー・ペーストできなかったので
　　一度ファイルとして保存し、Ｗｏｒｄ文書に挿入したこと
の３点です。

なお、特開２０１０－１の画像サイズは 3522バイトで、これはむしろ
かなり小さな画像です。

> また、「一度名前をつけて画像を保存」してマクロを
> 実行するよりは、図形の書式設定で直接、「高さ」
> および「幅」の倍率を入力したほうが速いように思われ、
> 省力化というマクロの目的を達成できません。

お気持ちはよくわかりますが、 （＾－＾）
「一度名前をつけて画像を保存」は、上記 (3) の理由で
特許電子図書館のシステムには何か特殊な事情があるかもしれない
と思われたからのことです。
システムを作るときはあらゆる可能性は全部ツブスのが原則ですので
おすすめした次第です。

なお、Excel 2007 では
InlineShape.ScaleHeight の型は Variant ではなく Single です。
但し試した結果、これも実行結果には影響していませんでした。

さらにもう一点
ご呈示のマクロにはミスとかバグらしい点は何もない
ことを申し添えます。

お役に立てればうれしいですが、
見当違いのコメントであれば、無視してくださいね。

お礼

mimeuさん、２回目のご回答、誠にありがとうございます。

　こちらこそ、mimeuさんの１回目のご回答をちゃんと理解せず
にコメントを記載して、申し訳ございませんでした。

　わざわざExcel 2007 でテストして頂きありがとうございます。

　「私の環境（IE 8.0.7600) では特許の画像をコピー・ペーストできなかった」
という貴重な情報をお教え下さり、ありがとうございます。

　私は、職場ではWORD 2003を使用していますが、自宅ではWORD 2007
を使用しており、WORD 2003ではコピー・ペーストできますが、WORD 2007
ではコピー・ペーストできなかったという経験があります。

　「特許電子図書館のシステムには何か特殊な事情があるかもしれない」
というアドバイスは非常にありがたく、今後のマクロ作成に生かしたい
と考えています。

　また、「システムを作るときはあらゆる可能性は全部ツブスのが原則」
であることもお教え下さり、ありがとうございます。

　私は、「西上原さん」の著書を読んでマクロを作成し始めたばかりの
初心者ですので、そのような原則に思い至りませんでした。
　今後のマクロ作成の参考にしていきます。

　さらに、WORD でも「inlineShape.ScaleHeight の型は Variant ではなく
Single」と思われ、インプットボックスで得られた数値を別のSingleの変数に
入れなおして、ScaleHeightに入力するマクロを試したことがありますが、
mimeuさんのおっしゃるように、特許電子図書館の図に対してはうまくいきま
せんでした。

回答No.3

Wendy02

#1 の回答者です。

その状況は分かりました。つまり、VBAで、出てくるものは、InLineShapeの高さ(Height, Width)も、実体の長さが取れていないことが原因のようです。と同時に、ネットから直接というか、クリップボードから取得したものには、ScaleHeight も ScaleWidth も、実体の長さが取れていないので、パーセント(%)の設定も出来ないようです。海外のサイトも調べてみましたが、未だ見つかりません。

一応、ドキュメントに収まらない大きなファイルは、50%になっていることが分かりましたが、ScaleHeight =.Height *　x/50 (x =30%) としてみましたが、もともと、この長さは、Bit ですから、そのままでは正しい値が出てきません。その出ている数値は、どうやら1次関数になっていないようですので、そのままでは当てはまりません。

一旦は、#2さんのご指摘の「ファイルをダウンロードする」のが正しい解答かとは思いますが、まだ、しばらく調べていますので、もう少し締めてしまうのは待ってください。

多くが同じ指摘をしているようです。ただ、これは、Excelでも同じ現象があるのですから、バグということではないようです。

このまま、3日経っても、何も返事が付かないようでしたら、申し訳ありませんが、解答がないと思ってください。

お礼

Wendy02さん、２回もご回答を賜り、本当にありがとうございます。

　しかも、海外のサイトまで調べて下さり、感謝しています。

　「大きなファイルがダメ」という情報は、貴重な情報で感謝しています。

　多くの方が同じ指摘していることは存じませんでした。

　貴重なアドバイスをありがとうございます。

回答No.2

mimeu

マクロは正常に動くようです。

特許・実用新案公報ＤＢから画像をいただくときに
ブラウザからＷＯＲＤファイルにコピー・ペーストではなく
一度名前をつけて画像を保存してから
ＷＯＲＤに図として挿入してみてはいかがですか？

お礼

mimeuさん、ご回答ありがとうございます。

　さて、「マクロは正常に動くようです」とおっしゃって下さい
ましたが、「補足」の（１）～（３）に記載しましたように、
残念ながら、正常に動いていないようです。

　また、「一度名前をつけて画像を保存」してマクロを
実行するよりは、図形の書式設定で直接、「高さ」
および「幅」の倍率を入力したほうが速いように思われ、
省力化というマクロの目的を達成できません。

補足

入力値と出力値との結果を、以下の（１）～（３）に
記載します。

　下記（２）および（３）の図１および２のように、大きな
図形に対しては、「倍率」を変更する「ScaleHeight」
プロパティが正常に機能していないようです。

　詳しくは、図１および２では、「３０」％の入力値
が「２２．７５」に換算された後、「サイズと角度」
を変更する「Height」プロパティの数値として出力
されているようです。

　この「ScaleHeight」プロパティが、「Height」プロパティ
として誤作動する原因をお教え下さいます様お願いします。

【入力値と出力値との結果】
　（１）以下の書式設定のケミドローで作成した化学式
に対してマクロを実行しますと（入力値＝３０）、
倍率が３０％に縮小され、マクロが正常に機能します。

　（１－１）マクロ実行前
　　　　　　　　高さ　　　　　　幅
　サイズと角度　32.81 mm　　　　32.81 mm
　倍率　　　　　100 %　　　　　 100 %
　原型のサイズ　32.68 mm　　　　32.85 mm

　（１－２）マクロ実行後
　　　　　　　　高さ　　　　　　幅
　サイズと角度　9.79 mm　　　　 9.79 mm
　倍率　　　　　30 %　　　　　　30 %

　（２）しかし、コピー・ペーストした特開２０１０－１の
図１に対してマクロを実行しても（入力値＝３０）、
倍率が３０％になりません。

　（２－１）マクロ実行前
　　　　　　　　高さ　　　　　　幅
　サイズと角度　112.45 mm　　　 51.06 mm
　倍率　　　　　50 %　　　　　　50 %
　原型のサイズ　224.9 mm　　　　103.72 mm

　（２－２）マクロ実行後
　　　　　　　　高さ　　　　　　幅
　サイズと角度　22.75 mm　　　　22.75 mm
　倍率　　　　　10 %　　　　　　22 %

　（３）また、コピー・ペーストした特開２０１０－１の
図２に対してマクロを実行しても（入力値＝３０）、
倍率が３０％になりません。

　（３－１）マクロ実行前
　　　　　　　　高さ　　　　　　幅
　サイズと角度　43.66 mm　　　　75.91 mm
　倍率　　　　　50 %　　　　　　50 %
　原型のサイズ　87.58 mm　　　　152.4 mm

　（３－２）マクロ実行後
　　　　　　　　高さ　　　　　　幅
　サイズと角度　22.75 mm　　　　22.75 mm
　倍率　　　　　26 %　　　　　　15 %

回答No.1

Wendy02

今、マクロを動かしてみているわけではないのですが、

　　If varX = "" Then
　　　 ActiveWindow.IMEMode = sinIME
　　　 End
　　End If

ここで、倍率を換えればよいのではありませんか？
varX

varX = varX *(30/22)
ちなみにバグではなくて、PCやソフトの固有の設定だからだと思います。

ただ、今回、DBサイトでは、具体例が見られなかったのではっきりとは書けませんが、なんとなくですが、

>Selection.Type <> wdSelectionInlineShape

最初に、既存のものだったら、オートシェイプの大きさをプロパティから取って、一旦貼りつけたPicture を再度取得しなおして、大きさを変更して貼りつければよいのだと思います。なぜ、一旦貼り付けるかというと、MS-Word として、Picture の認識をしないからです。

今、私が想像したただけですから、実際に回答のマクロは違うかもしれません。
ここでは、MS-Word Macro が得意だとしている方もいるようですから、他の方が、私の内容を否定して回答を書くかもしれません。

お礼

Wendy02さん、ご回答ありがとうございます。

　さて、上記「特開２０１０－１」の例では、

　図１について、インプットボックスに「３０」（％）
を入力しますと、「高さ」・「幅」に「１０％」・「２２％」
が出力され、

　図２について、インプットボックスに「３０」（％）
を入力しますと、「高さ」・「幅」に「２６％」・「１５％」
が出力されます。

　このように、図（イメージ）によって、入力値と出力値
との変化割合が異なるため、
"varX = varX *(30/22)"の方法では、残念ながら、
全ての図を処理することができません。

　なお、このマクロは、上記ＤＢで、テキストおよび
イメージ（図面や表など）データを含む特許文献を
ワードファイルに貼り付けた後、各イメージのサイズ
を調整するために作成しました。

　上記バグまたは設定の問題が解消できれば、
将来的に、ワードファイル上の全ての図（イメージ）
を、一度に同じ割合で縮小・拡大できるよう、
マクロを改良したいと考えています。