- 01: 名前:JOS投稿日:2005/03/01(火) 09:46
- Visio2003 WindowsXP/Windows2000
案内表示のような事をしたくてVBAで、適当な間隔でアイコンの色を
順番に替えていきそれを永久ループにして表示したところ
Visio.exeのメモリ使用量がどんどん増えていきそのうちに
Visio自体が死にました。何か回避方法はないでしょうか?
ループの間にDoEventsとAPIの Sleep をいれています。
- 02: 名前:yoda投稿日:2005/03/01(火) 10:07
- Timer関数ではどうでしょうね。
VBAのhelpにサンプルコードが
あります。
- 03: 名前:JOS投稿日:2005/03/01(火) 11:13
- ありがとうございます。
さっそく試してみたのですが状況は変わりませんでした。
タスクマネージャーのプロセスをみているとやはりメモリ使用が
増えていきます。何かワンクッションイベントを入れるか、メモリ
クリアみたいなのがあればいいような気はするのですがよく
わかりません。もしかしたらコードの書き方に問題があるかも?
以下サンプルです。
基本フローチャートの四角を5個貼り付けてマクロ登録
Sub DSP_test02()
Dim intI As Integer
Dim UndoScopeID1 As Long
Dim PauseTime, Start
'アイコン表示初期クリア
For intI = 1 To 5
UndoScopeID1 = Application.BeginUndoScope("塗りつぶしのプロパティ")
Application.ActiveWindow.Page.Shapes.ItemFromID(intI).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "1"
Next intI
intI = 5
While (1)
UndoScopeID1 = Application.BeginUndoScope("塗りつぶしのプロパティ")
Application.ActiveWindow.Page.Shapes.ItemFromID(intI).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "1"
intI = intI + 1
If intI > 5 Then
intI = 1
End If
UndoScopeID1 = Application.BeginUndoScope("塗りつぶしのプロパティ")
Application.ActiveWindow.Page.Shapes.ItemFromID(intI).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "2"
PauseTime = 1 ' 中断時間を設定します。
Start = Timer ' 中断の開始時刻を設定します。
Do While Timer < Start + PauseTime
DoEvents ' 他のプロセスに制御を渡します。
Loop
'DoEvents
'Sleep (100)
Wend
End Sub
- 04: 名前:yoda投稿日:2005/03/01(火) 12:05
- 急激にどうということはなく、安定していますが。
どのくらいの時間でダウンするのでしょう。
- 05: 名前:JOS投稿日:2005/03/01(火) 13:50
- さっそくためしていただいてありがとうございます。
サンプルでは遅いので時間を1秒から0.1秒に変えて
加速してテストしました。
実行してから約27分で死にました。
動かしていたのはVisioとタスクマネージャーのプロセスの表示です。
Visio.exeのメモリ使用量をみていると70MBを超えるまでは動いて
いました。そのあとどこまで行って落ちたかは正確にはわかりません
動作環境
Epsonノートパソコン
IntelPentiumM 1.4GHz メモリ 512MB
WindowsXP Pro SP1
Visio2003 Pro
- 06: 名前:yoda投稿日:2005/03/01(火) 14:20
- これでよいかどうかは分かりませんが、
1つは、UndoScopeIDの行をすべて削除、してはどうでしょうか。
必要がないものは、ない方がよいでしょう。
無限ループの中で、オブジェクトへの参照をできるだけ少なくしたらどうでしょうか。
これも、負荷軽減になると思いますが。
それでいいのかどうかは分かりませんが、たとえば、
Sub DSP_test02()
Dim intI As Integer
Dim PauseTime, Start
Dim myCell(1 To 5) As Cell
'アイコン表示初期クリア
For intI = 1 To 5
Set myCell(intI) = ActiveWindow.Page.Shapes.ItemFromID(intI). _
CellsSRC(visSectionObject, visRowFill, visFillForegnd)
myCell(intI).FormulaU = "1"
Next intI
intI = 5
While (1)
myCell(intI).FormulaU = "1"
intI = intI + 1
If intI > 5 Then
intI = 1
End If
myCell(intI).FormulaU = "2"
PauseTime = 1 ' 中断時間を設定します。
Start = Timer ' 中断の開始時刻を設定します。
Do While Timer < Start + PauseTime
DoEvents ' 他のプロセスに制御を渡します。
Loop
'DoEvents
'Sleep (100)
Wend
End Sub
- 07: 名前:鳥肌投稿日:2005/03/02(水) 10:08
- UndoScopeIDの行を全て削除すると、生存時間が長くなるようです。
さらに1行目に下記を追加すると、メモリの増加自体を防げます。
Application.UndoEnabled = False
- 08: 名前:JOS投稿日:2005/03/02(水) 15:11
- ありがとうございます。
UndoScopeIDの行を全て削除して実行しておりますが30分もたなかった
のが6時間を経過しても動いています。しかしVisio.exeのメモリ自体は
かなり増加して最初20M位だったのが400Mを越えたあたりで200Mまたは
300M台に1度下がってまた増え始める動きを繰り返しているようです。
いつ止まるかなと見ていて書き込みに気づきApplication.UndoEnabled = False
を入れてみました。なんかうまくいきそうです。
いくらVB/VBAが使えるからといっても図を描くのが本来の機能なので
自動表示のようなことは所詮無理かなとあきらめかけていたのですが
うまくいきそうです。しばらく連続動作させてみます。ありがとうございました。
- 09: 名前:yoda投稿日:2005/03/02(水) 17:15
- Application.UndoEnabled = False
が決定打でしたね。
鳥肌さんありがとうございました。
■トップに戻る リロード 単独スレ表示
|