| |
▼rinn さん：
こんばんは。
。
>そこでここまできたらもうひとつお願いがありますので聞いていただけませんか？
>実はそのオートシェイプで作った一覧表ですが、何度も再表示をさせたいので表示させる時に前回のデータがあれば全部削除したいと考えています。
>
>mainの最初に
>
>ActiveSheet.Shapes.SelectAll
>Selection.Delete
>と記述し、オートシェイプ全部選択して削除という方法でいけるかと思ったのですが、
>「メモリが不足しています」
>とエラーが出ます。
このエラーの直接の原因はわかりません。
ただ、私もシェイプの作成･削除を繰り返した結果、
同じことを行うのに処理が遅くなったり、
Excelが異常終了したりしたことがあります。
提示したコードは、サンプルとして投稿したものなので、
ＶＢＡコードと基になるデータと稼動一覧表が
同じブックにありますが、これを
基になるでーたのあるブックと稼動一覧表を作成するブックを分けてしまうことを提案します
（最終的には、ＶＢＡコードのあるブックと基になるデータも分けてしまうほうが良いとおもいますが・・・）。
例えば、基になるデータのあるシート（Sheet1）に
ボタン（コマンドバー「フォーム」のボタン）を設置して
このボタンに先に提示したmainを登録します。
但し、mainを若干変更します。
'===================================================================
Const hh = 4 '目盛り列の巾数
Sub main()
Dim idx As Long
Dim rw As Long
Dim svrw As Long
Dim st As Single
Dim wk As Double
Dim shp As Shape
Dim cl As Long '四角の色
Dim eventno As Long
Dim shpnm As String
With Workbooks.Add.ActiveSheet
.Columns("a").ColumnWidth = 10
.Columns("b:z").ColumnWidth = hh
.Range("a1").Value = #5/1/2006#
With .Range("b1:z1")
.Formula = "=column()-2&""時"""
.Value = .Value
End With
Call open_scale(2, 10, hh, .Columns("b").Width)
With ThisWorkbook.Worksheets("sheet1")
idx = 2
svrw = 0
Do Until .Cells(idx, 1).Value = ""
rw = .Cells(idx, 3).Value + 1
wk = Application.Min(.Cells(idx, 6).Value + .Cells(idx, 7).Value, Range("a1").Value + 1) - _
Application.Max(.Cells(idx, 4).Value + .Cells(idx, 5).Value, Range("a1").Value)
If wk > 0 Then
If svrw <> rw Then
cl = 3
svrw = rw
Else
cl = cl + 1
End If
Cells(rw, 1).Value = .Cells(idx, 3).Value
st = (Application.Max(.Cells(idx, 4).Value + .Cells(idx, 5).Value, Range("a1").Value) _
- Int(Application.Max(.Cells(idx, 4).Value + .Cells(idx, 5).Value, Range("a1").Value))) * 24 * hh
Set shp = mk_rectangle(Rows(rw), st, wk * 24 * hh)
shpnm = "shp" & idx
eventno = .Cells(idx, 2).Value
With shp
.Name = shpnm
.TextFrame.Characters.Text = "イベントNO" & eventno
.TextFrame.HorizontalAlignment = xlHAlignCenter
.Fill.ForeColor.SchemeColor = cl
.Fill.Transparency = 0.75
End With
End If
idx = idx + 1
Loop
End With
End With
End Sub
上記のようにすると、常に新規ブックに稼動一覧表が作成されます.
このようにすれば、シェイプの削除も必要ないですよね！！
ちょうど、「印刷するときは、いつも新しい真っ白の紙に印刷する」
という考え方です。
作成した一覧表を閲覧するだけで必要なくなったら、
そのブックは保存せずに閉じる。
というような使用方法です。
まさにオンデマンドでしょう？？
更に進んで私なら、ＶＢＡコードと基データも分けてしまいますけどね！！
シートのシェイプを一度削除すると言う方法も出来ると思いますが、
上記のような仕様を検討してみて下さい
以上です。
|
|
ichinose
- 06/5/17(水) 22:34 -
