Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


44003 / 76732 ←次へ | 前へ→

【37753】Re:入退出一覧表を作りたいです(結構複...
発言  ichinose  - 06/5/17(水) 22:34 -

引用なし
パスワード
   ▼rinn さん:
こんばんは。

>そこでここまできたらもうひとつお願いがありますので聞いていただけませんか?
>実はそのオートシェイプで作った一覧表ですが、何度も再表示をさせたいので表示させる時に前回のデータがあれば全部削除したいと考えています。
>
>mainの最初に
>
>ActiveSheet.Shapes.SelectAll
>Selection.Delete
>と記述し、オートシェイプ全部選択して削除という方法でいけるかと思ったのですが、
>「メモリが不足しています」
>とエラーが出ます。
このエラーの直接の原因はわかりません。
ただ、私もシェイプの作成・削除を繰り返した結果、
同じことを行うのに処理が遅くなったり、
Excelが異常終了したりしたことがあります。

提示したコードは、サンプルとして投稿したものなので、
VBAコードと基になるデータと稼動一覧表が
同じブックにありますが、これを
基になるでーたのあるブックと稼動一覧表を作成するブックを分けてしまうことを提案します
(最終的には、VBAコードのあるブックと基になるデータも分けてしまうほうが良いとおもいますが・・・)。

例えば、基になるデータのあるシート(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


上記のようにすると、常に新規ブックに稼動一覧表が作成されます.
このようにすれば、シェイプの削除も必要ないですよね!!
ちょうど、「印刷するときは、いつも新しい真っ白の紙に印刷する」
という考え方です。
作成した一覧表を閲覧するだけで必要なくなったら、
そのブックは保存せずに閉じる。
というような使用方法です。
まさにオンデマンドでしょう??

更に進んで私なら、VBAコードと基データも分けてしまいますけどね!!

シートのシェイプを一度削除すると言う方法も出来ると思いますが、

上記のような仕様を検討してみて下さい


以上です。
0 hits

【37596】入退出一覧表を作りたいです(結構複雑で... rinn 06/5/12(金) 17:13 質問
【37603】Re:入退出一覧表を作りたいです(結構複雑... ichinose 06/5/12(金) 18:54 発言
【37679】Re:入退出一覧表を作りたいです(結構複... rinn 06/5/15(月) 16:44 質問
【37701】Re:入退出一覧表を作りたいです(結構複... ichinose 06/5/15(月) 23:02 発言
【37715】Re:入退出一覧表を作りたいです(結構複... rinn 06/5/16(火) 13:10 質問
【37728】Re:入退出一覧表を作りたいです(結構複... ichinose 06/5/16(火) 23:54 発言
【37741】Re:入退出一覧表を作りたいです(結構複... rinn 06/5/17(水) 16:34 質問
【37743】Re:入退出一覧表を作りたいです(結構複... rinn 06/5/17(水) 16:41 発言
【37753】Re:入退出一覧表を作りたいです(結構複... ichinose 06/5/17(水) 22:34 発言
【37771】Re:入退出一覧表を作りたいです(結構複... rinn 06/5/18(木) 15:47 お礼
【37802】Re:入退出一覧表を作りたいです(結構複... ichinose 06/5/18(木) 22:06 発言
【37813】Re:入退出一覧表を作りたいです(結構複... rinn 06/5/19(金) 9:53 お礼
【37731】Re:入退出一覧表を作りたいです(結構複... ハチ 06/5/17(水) 12:27 発言
【37742】Re:入退出一覧表を作りたいです(結構複... rinn 06/5/17(水) 16:35 お礼

44003 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free