プロが教えるわが家の防犯対策術!

前回の質問の続きです。
  (前回 https://oshiete.goo.ne.jp/qa/9376599.html)

クリップボードがダメなら、UserPictureメソッドしかないということで、クッリプボードの図をemf形式でファイル化するプロシージャーを入手しました。(http://www.oaltd.co.uk/Excel/Default.htmのPastePicture.zip)

そして、下記のプロシージャーを作成しました。
そして、aa()の1回目は問題なく実行できます。
しかし、選択するShapeを変更して2回目を実行すると、”SavePicture oPic, FN”の行でエラー。「書き込みできません。(Error 70)」で実行できません。Helpを見ると「・別のプロセスでロックされているファイルに書き込もうとしています。 別のプロセスが解放してから、ファイルを開きます。 」とあります。
(エラーの出方が不安定です。コードを修正するとできるときもありますが、保存後再起動すると同様にエラーが出ます。)

その他の状況は、
(1) ”cc FN”をコメントアウトすると何回でも問題なく実行できます。
(2) また、エラーの発生時に、エクスプローラからzzz.emfを削除しようとすると、エクセルが使用していて削除不可とのこと。
(3) 手動でファイルから塗りつぶし設定を行うと、そのファイルはすぐに削除可能なこと。

これらから、cc()のコードに問題があり、ファイルを解放しないようなのですが、何が悪いのかさっぱり判りません。

よろしくアドバイスをお願いします。

Private Sub aa()
 Dim FN As String
 FN = "zzz.emf"
 Selection.Copy ’事前にShapeを選択してます
 Set oPic = PastePicture(14) '入手プロシージャーの呼び出し
 SavePicture oPic, FN '同 ファイル保存ステップのプロシージャーの呼び出し

 cc FN
End Sub

Sub cc(FN As String) '塗りつぶし処理
 Dim Oj As Object
 ActiveSheet.Shapes("Rectangle 14").Select
 Set Oj = Selection
 Oj.ShapeRange.Fill.UserPicture FN
 Set Oj = Nothing
End Sub

A 回答 (1件)

すみません。

質問の細かい所無視ですが、
埋込み型グラフ(シート上)に、ひとつ置いて、実行すれば、図の中にチャートが入ります。この操作というのは、簡単だけれども、古い技術なのです。
ただ、私のほうでは、絵がボケていますね。やはり専用ツールのほうがよいかもしれません。


Sub Test1()
Const TEMP As String = "$Temp.gif"
Dim Shp As Shape
With ActiveSheet

 .ChartObjects(1).Chart.Export Filename:=TEMP, FilterName:="GIF"
 Set Shp = .Shapes.AddShape(msoShapeRectangle, 250, 250, 360, 200)
 Shp.Fill.UserPicture PictureFile:=ThisWorkbook.Path & TEMP
 Shp.Visible = msoTrue
 Kill ThisWorkbook.Path & TEMP 'TEMPファイルの削除
 Set Shp = Nothing
End With

End Sub

>ActiveSheet.Shapes("Rectangle 14")
既存のオートシェイプに貼り付けるのは、面倒ですね。
いっそ、Selection にしてしまったほうが速いと思います。

なお、クリップボードから取り出す話は、一応なしにしてください。かなり面倒だからです。クリップボードの中身を1つずつ調べて、必要なものを取り出さないといけないのです。

そういうメソッドが、Excel側にVBAには用意されていないので、一から、取り出すプログラムを作らなくてはなりません。クリップボードの蓋を開けて取り出して蓋を閉めるという作業なのです。(^^;
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!