大量の図変換でVBAが遅い

Excel2007を使用しています。
ActiveXコントロール「Microsoftバーコードコントロール 9.0」にてバーコードを生成後、
図（拡張メタファイル）として変換するというVBAを作成しています。
動作としては完成したのですが、後半に行くに従い処理が遅くなっていきます。
スタート時は10個/秒ほどですが、
最後付近は2秒/個ほどになってしまいます。
手元の環境で、700個で240秒ほどかかります。
少しでも速度を改善させる方法はありますでしょうか。
バーコード生成部分はFunctionでサブルーチンから切りだしています。
サブルーチンでは、再描画の停止（ScreenUpdating = False）や、
手動計算への切換（Calculation = xlCalculationManual）は定義しています。

-------------------------------------------------------------------
Function ShowBarCode(P_Left As Long, P_Top As Long, P_Width As Integer, _
P_Height As Integer, P_Value As String, P_Style As Integer)

Application.ScreenUpdating = False
Dim mySht As Worksheet
Set mySht = ActiveSheet

Dim myShp1 As Object

' セルにバーコードを貼付ける
Set myShp1 = mySht.OLEObjects.Add(ClassType:= _
"BARCODE.BarCodeCtrl.1", Link:=False, DisplayAsIcon:=False, _
Left:=P_Left, Top:=P_Top, Width:=P_Width, Height:=P_Height)
With myShp1
.Object.Style = P_Style
.Object.Value = P_Value
.Width = .Width - 3　　　' 再描画のための小細工
.Width = .Width + 3　　　' 再描画のための小細工
　　End With

' バーコードを図（メタファイル）として変換
myShp1.Copy
ActiveSheet.PasteSpecial Format:="図 (拡張メタファイル)", Link:=False, DisplayAsIcon:=False

' バーコードを削除
myShp1.Delete

End Function
-------------------------------------------------------------------

添付図：バーコード付きシート　サンプル

No.4 ベストアンサー 回答者： ap_2 回答日時： 2011/10/18 17:49

> 画像Pasteのみ1万回で10秒、処理速度は一定でした

Excel2003使ってた・・・
確かに、2007だと異様なペースで遅くなっていきますね（－－；
OLEObjects.AddもPictures.Pasteも遅いんじゃ、代替手段が・・・

あ、あった！

なぜか、セルごとコピペすれば遅くならない。
　1. 他シートの適当なセルに、PasteSpecial
　2. 1で画像を貼った"セル"をCopy　（画像ごと取れる）
　3. 目的の位置に、"セル"をPaste　（画像ごと貼れる）

よく思いついたと褒めてほしいですｗ

この回答へのお礼

引き続きの回答有難う御座います！
ご指摘の方法で３倍早くなりました！
どういう仕様なんでしょうかね。。。
とりあえず一旦高速化はこれでよしとします。
長いお付き合いありがとうございました！

お礼日時：2011/10/19 20:20

No.3 回答者： ap_2 回答日時： 2011/10/15 06:55

画像Pasteのみ1万回で10秒、処理速度は一定でした

遅くなるものとばかり・・・自分のプログラムも見直しそうかな（－－；

「画像が多いとPasteSpecialが遅い」なら、一度他シートで画像化とか
原因箇所＆条件が分かれば、工夫の余地もあるかも。
時間測定関数を添付します、いろいろ試してみてください。

Private Declare Function timeGetTime Lib "winmm.dll" () As Long
'イミディエイトウィンドウに時間(ミリ秒)とログを出力
Sub DevLog(str)
Static t&
Debug.Print Right(" " & timeGetTime() - t, 7) & " : " & str
t = timeGetTime()
End Sub

Sub test()
Dim r, c
Application.ScreenUpdating = False
ActiveSheet.Shapes("Picture 1").Copy
DevLog "---> test start"
For r = 1 To 100
DevLog "Row = " & r
For c = 1 To 100
　ActiveSheet.Cells(r, c).Select
　ActiveSheet.Paste
Next
Next
End Sub

この回答へのお礼

Function部分でCopyとDelete、
メイン部分でPasteSpecialのみ実施するように変更しています。
一つのバーコードを複数貼り付ける場合があるため、
この方法でも少し速度改善しています。

上記PasteSpecial部分のみコメントアウトすると、
速度は一定で10秒ほどで完了します。

試しに、700枚ほどのバーコード付きの完成したシートに対して、
追加する形でコードを実行したところ、
最初からマクロ実行速度は遅かったです。

やはり、画像が多くなるに連れ処理速度は低下してしまうものなのでしょうか。

お礼日時：2011/10/17 13:29

No.2 回答者： ap_2 回答日時： 2011/10/13 18:42

毎回Addせず、オブジェクトを使い回してみては？

Add＆Deleteを繰り返すと、内部でどーなっちゃうのか・・・
Sheetsだとファイルサイズが増えていったり、信用できない部分です。
速度に関係なく、避けたい気はします。。

コレクション（～s）は要素数によって徐々に遅くはなるんですが、
700程度じゃ僅かです。描画を止めてるなら、他要因だと思いますよ。

この回答へのお礼

一度Addしたものをひな形に、
Valueを変更してコピーする方法に変えてみたところ、
半分ぐらいの実行時間に改善されました。
どうもありがとうございます。
それでも700個で120秒ほどかかり、
後半に行くに従い遅くなっていきました。

お礼日時：2011/10/14 13:53

No.1 回答者： nicotinism 回答日時： 2011/10/12 09:20

試したわけではないので効果は不明ですが、

' バーコードを削除
myShp1.Delete
Set myShp1 = Nothing
Application.cutcopymode = false
だとどうでしょ？
メモリにゴミが溜まって遅くなっているような気がします。
藪医者の診たてなので、期待しないでください (^^ゞ

この回答へのお礼

回答有難う御座います。
実行して見ましたが速度改善は見られませんでした。
同シート内にオブジェクトを貼り付け過ぎなのが原因と思われますので明確な改善方法が見つかりません。
でも、回答嬉しかったです。

お礼日時：2011/10/13 09:33