Excel VBA質問箱 IV

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

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


7642 / 13644 ツリー ←次へ | 前へ→

【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 お礼[未読]

【37596】入退出一覧表を作りたいです(結構複雑で...
質問  rinn  - 06/5/12(金) 17:13 -

引用なし
パスワード
   同ブックの別シートに読み込んだ一覧の値を使用し、以下のようなイメージの
ものを作成したいのです。(ちょっとわかりにくいですが…)

時間| 0時     12時        18時     23時
No.1| ===        ==== ===    ===========
  |
No.2|      =======      ========
  |


一覧には、No(部屋番号)、入場日、入場時間、退場日、退場時間が入っています。
要するに1日ごと、部屋ごとの入退出管理の一覧表がほしいというわけです。
上記の「=」で示した箇所は入場開始から終了までを表します。

実際には時間の目盛りは1時間毎となっていて、単純に時間のシリアル値を参照して「=」をそのセルに代入という方法を取ると、例えば8:30開始の時と8:05開始の時が同じになってしまいよくありません。
単純にVLookup関数などを使用し、表の目盛りの上に検索用のシリアル値を入力しておき検索でひっかけようかとも思いましたがこれもまたうまくいきません。
目盛りを15分単位に変えてもみましたが、元々必ず一致するというデータではありませんのでこれでは無理そうです。
15分単位にしてもその間の数値というのがありますので、いちいちひとつずつ、0時から0:15の間ならば下のセルに「=」を挿入するというやり方をするとなればループ回数が多すぎて処理に時間がかかりそうです。
しかもプログラムもかなり長く複雑になると思います。
またオートシェイプを使ってやってみようと考えましたが、検索の際にどうやって時間の開始と終了、棒の長さを変数に代入すればいいのかもわかりませんでした。

初心者の為いいアイデアが浮かびません。
もっと手っ取り早くこの表作成を実現するいいアイデアはありませんか?
よろしくお願いします。

【37603】Re:入退出一覧表を作りたいです(結構複...
発言  ichinose  - 06/5/12(金) 18:54 -

引用なし
パスワード
   ▼rinn さん:
こんばんは。
以前、似たようなご質問があったなあと思い、検索してみました。

http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=25861;id=excel

但し、これはオートシェープを使ったものです。

>またオートシェイプを使ってやってみようと考えましたが、検索の際にどうやって時間の開始と終了、棒の長さを変数に代入すればいいのかもわかりませんでした。

↑これは、
基になる表があるんでしょう?(別のシートに)
オートシェープの名前(オブジェクト名)の中にそのデータのある行の情報を
入れとけば、良いのではないですか?

例えば、オブジェクト名が「Obj100」なら、データシートの
100行目にこのオブジェクトの詳細情報があるので参照できる。

ということなのですが・・・。
検討してみて下さい

【37679】Re:入退出一覧表を作りたいです(結構複...
質問  rinn  - 06/5/15(月) 16:44 -

引用なし
パスワード
   ▼ichinose さん:

こんにちは。
このオートシェイプを使用したものは使えそうです。
ありがとうございます。
しかし応用が必要で私は初心者の為すぐには理解できず、今どうすれば応用できるか考え中です。


>基になる表があるんでしょう?(別のシートに)
>オートシェープの名前(オブジェクト名)の中にそのデータのある行の情報を
>入れとけば、良いのではないですか?
>
>例えば、オブジェクト名が「Obj100」なら、データシートの
>100行目にこのオブジェクトの詳細情報があるので参照できる。
>
>ということなのですが・・・。

おっしゃってる意味はわかりますし、そうすればできるのではないかとも思いますが、何しろ初心者の為それをどうやって実現すればいいのかがまだわかりません。
今独学でテキストを渡されたのみでこの業務アプリをひとりで開発し始めたばかりで、全くの勉強不足です。すいません。
しばらくこの方法については検討してみるつもりです。

そして今回の質問ついでに、私が実現したいことをもうひとつ付け加えて質問させていただきたいと思います。

以前のものであると日付ごとに1行ずつ表示をしているようですが、私の場合部屋番号ごとに1行ずつ表示させることになります。
1行でたくさんのオートシェイプが表示されることになるので、例えば一番左にあるオートシェイプは黄色、次は緑などとせめて隣り合わせる色は変えたいと思います。
この方法があれば教えていただければありがたいです。
それではよろしくお願いします。

【37701】Re:入退出一覧表を作りたいです(結構複...
発言  ichinose  - 06/5/15(月) 23:02 -

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

>このオートシェイプを使用したものは使えそうです。
>ありがとうございます。
>しかし応用が必要で私は初心者の為すぐには理解できず、今どうすれば応用できるか考え中です。

http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=25861;id=excel

ここで提示したコードが正常に作動しましたか?


まずは、リンク先のプログラムが作動するような
入力データの作成から始めて、とにかく、一度作動させてみて下さい。

もし、作動したなら、これを一行一行、理解して頂くしかないでしょうねえ!!

それで、不明な点があったなら、ピンポイントで質問してください。


尚、上記リンク先の
>Function mk_rectangle(rng As Range, 開始 As Single, 巾 As Single, Optional sht As Worksheet = Nothing, Optional txtstr = "") As Shape



Function mk_rectangle(rng As Range, 開始 As Single, 巾 As Single, Optional sht As Worksheet = Nothing) As Shape

に訂正してください(訂正しなくても作動はしますが)。


>そして今回の質問ついでに、私が実現したいことをもうひとつ付け加えて質問させていただきたいと思います。
>
>以前のものであると日付ごとに1行ずつ表示をしているようですが、私の場合部屋番号ごとに1行ずつ表示させることになります。
>1行でたくさんのオートシェイプが表示されることになるので、例えば一番左にあるオートシェイプは黄色、次は緑などとせめて隣り合わせる色は変えたいと思います。
>この方法があれば教えていただければありがたいです。

入力データ(No(部屋番号)、入場日、入場時間、退場日、退場時間)の例の記述が
ないので、はっきりしたことは言えませんが、
部屋NO毎に入場時刻などでソートし、その順序でオートシェイプを作成すれば、
色の変化を付けることは可能だと思います。
仕様を煮詰めていけば、他にも方法はあるかもしれません!!
いずれにせよ、色を変えることはできます。


まずは、仕様書を作成してください。

このプログラムの機能概要からはじめて、

・ 入力データ
 (No(部屋番号)、入場日、入場時間、退場日、退場時間)の入力方法や
  記述例

・上記の入力データから、どんな結果を出力したいのか
 これも例を交えて記述

・具体的なプログラムのオペレーティング(操作手順)

・その他

この仕様書を読んだ人が概、どんなプログラムなのかわかるような
ドキュメントです。
この仕様書を記述していく中で

ご自分が、このプログラムを作るのに何がわからないのか

何を知らなければならないのか
等が具体的に見えてくると思います。
あるいは、記述するまでは、わからなかったアルゴリズムが
わかってくるかもしれません。

私もプログラムを作る前に必ずこの仕様書を記述しますが、
これはユーザーのためというより、自分のためなのです
(ユーザーはほとんどドキュメントなんて読んでくれませんしね・・・)。

まだ、どこから手をつけてよいか迷っておられるのなら、
仕様書の作成をお勧めします。

【37715】Re:入退出一覧表を作りたいです(結構複...
質問  rinn  - 06/5/16(火) 13:10 -

引用なし
パスワード
   ▼ichinose さん:
こんにちは。
リンク先のコードは正常に動作していることはすでに確認済みです。

コードを解析しておおまかな流れはつかめましたが、応用方法がまだいまいちわかりません。
仕様書作成にはチャレンジしてみたいですが、どこから手をつけてどのようなものを作成すればいいかわかりませんのでそれも考え中です。
自社売上管理ソフトを作成しようとしていますし、今まで自社でそのように開発したことがなかったようで、いいサンプルもありません。
とにかくやってみるしかありませんが・・・

それはさておき、質問をさらにさせていただきます。

元になるデータはサーバの売上(テキスト)データからエクセルのシートに必要な情報だけ読み込ませていますので、私が昨日発言させていただいた内容を読み返すと少し表現を間違えていました。
データは下記のような感じです。
質問するのに情報が足りなくてすいません。


No イベントNo 部屋番号 入場日付 入場時間 退場日付 退場時間 料金
----------------------------------------------------------------------
1  4     1    2006/05/01  20:03 2006/05/01  21:50  \1000
2  4     2    2006/04/30  23:00 2006/05/01  10:05  \3000
3  4     2    2006/05/01  12:30 2006/05/01  13:10  \500
4  5     3    2006/05/01  08:00 2006/05/01  15:40  \4500


テキストデータからこの状態にもっていくまででもかなり苦労しました。。。
部屋番号を基準にソートしており、その中でも日付と時間でもソートしています。
これは別シートにあり、他のシートには売上一覧やグラフを表示させておりそのための作業シートのように使用しています。
私が今回作成したいと考えていますのは、一日ごとの部屋別の稼働状況を一覧で表示させたいです。
最初に質問させていただいた時に書いたもので下記のようなイメージです。


時間  0時     12時        18時     23時
No.1 ====        ==== ===    ===========
  
No.2     =======      ========
  

ichinose さんから教えていただいた方法を応用すれば簡単にできそうですね。
私にはあと1週間は最低かかると思いますがやってみます。

それとコードの件で質問があります。
Function mk_rectangleの中の変数「wk」と「wk2」、「ha」と「ha2」が意味するのは何でしょうか?
オートシェイプを時間の情報から作成している箇所であるというのはわかります。またその開始位置とオートシェイプの幅などを決めているというのもわかりますが、この関数の中で色々な計算がされていてちょっと混乱しています。
上記4つの変数がどのような意味をもって定義されているのかわかればあともう一歩ではないかなと思います。

何度も何度も質問すいませんがよろしくお願いします。

【37728】Re:入退出一覧表を作りたいです(結構複...
発言  ichinose  - 06/5/16(火) 23:54 -

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

>仕様書作成にはチャレンジしてみたいですが、どこから手をつけてどのようなものを作成すればいいかわかりませんのでそれも考え中です。
それは、rinnさんが この仕様書あるいは、マニュアルはわかりやすいと感じたものを
模倣すればよいのです。


>No イベントNo 部屋番号 入場日付 入場時間 退場日付 退場時間 料金
>1  4     1    2006/05/01  20:03 2006/05/01  21:50  \1000
>2  4     2    2006/04/30  23:00 2006/05/01  10:05  \3000
>3  4     2    2006/05/01  12:30 2006/05/01  13:10  \500
>4  5     3    2006/05/01  08:00 2006/05/01  15:40  \4500

例えば、上記のデータが新規ブックの「Sheet1」というシートの
セルA列からH列に入力されているとします。
(1行目は、項目名です)
部屋別の稼働状況は、Sheet2に作成します。
このSheet2の右側には、作業シートのSheet3があるものとします。


標準モジュールに

'============================================================
Const hh = 6 '目盛り列の巾数
'============================================================
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 ActiveSheet
    .Columns("a").ColumnWidth = 11
    .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, 11, hh, .Columns("b").Width)
    With 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


別の標準モジュールに

'============================================================
Private st_col As Single
Private st_point As Single
Private myscale As Single
Private sswidth As Single
'============================================================
Sub open_scale(開始列, 開始列までのセル巾, 目盛り巾, 目盛りPnt)
' チャート作成するシート情報を登録する
' input :  開始列 --チャート作成開始列
'      開始列までのセル巾--- 列幅の合計値
'      目盛り巾------------目盛りとなる列の列幅
'      目盛りPnt-----------目盛りとなる列のWidth
  st_col = 開始列
  st_point = 開始列までのセル巾
  myscale = 目盛り巾
  sswidth = 目盛りPnt
End Sub
'============================================================
Function mk_rectangle(rng As Range, 開始 As Single, 巾 As Single, Optional sht As Worksheet = Nothing) As Shape
'指定された行に開始位置,巾の情報から、チャートを作成する
'input  : rng---作成する行を表すRangeオブジェクト
'      開始---チャート作成開始位置を開始列からの列幅単位で指定
'      巾-----チャート作成巾を列幅単位で指定
'      sht----チャートを作成するシートオブジェクト 尚、このシートの右のシートは作業シートとして
'         使用します。
'      txtstr----チャートに記述する文字列
'output : mk_rectangle----作成したShapeオブジェクト
  Dim mkleft As Single
  Dim mkwidth As Single
  If sht Is Nothing Then Set sht = ActiveSheet
  wk = Int(開始 / myscale) * myscale
  wk2 = (開始 - wk) / myscale
  ha = Int(巾 / myscale) * myscale
  ha2 = (巾 - ha) / myscale
  cnv_left = get_point(wk + st_point, sht.Next)
  cnv_width = get_point(ha, sht.Next)
  If wk2 = 0 Then
    mkleft = cnv_left + 3.75 * (st_col - 1 + Int((開始 - 0.1) / myscale))
  Else
    mkleft = cnv_left + 3.75 * (st_col - 1 + Int((wk - 0.1) / myscale)) + sswidth * wk2
    End If
  If ha2 = 0 Then
    If ha = 0 Then
     mkwidth = cnv_width
    Else
     mkwidth = cnv_width + 3.75 * Int((ha - 0.1) / myscale)
     End If
  Else
    If ha = 0 Then
     mkwidth = cnv_width + sswidth * ha2
    Else
     mkwidth = cnv_width + 3.75 * Int((ha - 0.1) / myscale) + sswidth * ha2
     End If
    End If
  
  With rng
    Set mk_rectangle = sht.Shapes.AddShape(msoShapeRectangle, mkleft, .Top, mkwidth, .Height)
    End With
End Function
'============================================================
Function get_point(セル幅, sht As Worksheet)
  With sht
    .Cells(1, 1).ColumnWidth = セル幅
    get_point = IIf(.Cells(1, 1).Width <= 0, 0, .Cells(1, 1).Width)
   End With
End Function


として、Sheet2をアクティブにした状態で

mainを実行してみて下さい。

プログラムは、2006/5/1の部屋別の稼働状況を作成します。


>それとコードの件で質問があります。
>Function mk_rectangleの中の変数「wk」と「wk2」、「ha」と「ha2」が意味するのは何でしょうか?
>オートシェイプを時間の情報から作成している箇所であるというのはわかります。またその開始位置とオートシェイプの幅などを決めているというのもわかりますが、この関数の中で色々な計算がされていてちょっと混乱しています。
>上記4つの変数がどのような意味をもって定義されているのかわかればあともう一歩ではないかなと思います。

オートシェイプの作成は、スケールとなる列の幅(上記のコードでは、hh--->6)を基準に
してポイントに変換して作成しています。

ところが、

新規ブックで以下のコード実行し見てください。


Sub test()
  Columns("a").ColumnWidth = 12
  Columns("b:c").ColumnWidth = 6
  MsgBox Range("a1").Width & "-----" & Range("b1:c1").Width
End Sub

一つの列で列幅12の列と
二つの列で列幅6の列の列の横幅の合計ポイントは上記の結果が
示すように微妙に違いますよね?

この微妙な違いを考慮にいれないと正しい位置やスケールを持った
オートシェイプの作成ができません。

上記の変数はその補正計算を行うための計算に使用しています。


以上です。

【37731】Re:入退出一覧表を作りたいです(結構複...
発言  ハチ  - 06/5/17(水) 12:27 -

引用なし
パスワード
   自分も作ってみました。
Excel2000以降なら動作すると思います。
データのあるSheet名は"Data"としてます。
左端に日付のシートが作成されます。

直しながら作っていたらインデントがグチャグチャに・・・・
読み辛くてゴメンナサイ。

'初期設定

Const Cell_W = 4 'セル幅
Const Cell_H = 16 'セル高さ
Const Shp_H = 12 'オートシェイプの太さ < セルの高さの範囲内で指定
Const St = "C4" 'オートシェイプの開始セル


Sub Shp_Test()
'初期設定エラーチェック
If Shp_H > Cell_H Then MsgBox "設定エラー": Exit Sub

Dim i, r, Shp_r As Long
Dim Ans As Variant
Dim Shp_Cl As Integer
Dim In_T, Out_T As Double
Dim Gap_T, Shp_T, Shp_L, Shp_W As Single
Dim St_T, St_L As Single
Dim Total_W As Single
Dim St_R As Range
Dim Tar_Sh As Worksheet
Dim MyShp As Shape
Dim Room As Integer

Ans = InputBox("作成する日付を入力してください(yyyy/mm/dd)", "作成日")
'Ans = "2006/05/01"
Ans = CDate(Ans)

Gap_T = (Cell_H - Shp_H) / 2
Total_W = Cell_W * 24

Worksheets.Add Before:=Worksheets(1)
Worksheets(1).Name = Format(Ans, "yyyymmdd")

Set Tar_Sh = Worksheets(1)

With Tar_Sh

  Set St_R = .Range(St)

  '24時間5行分の範囲で整形
  .Range(St_R, St_R.Offset(5, 23)).ColumnWidth = Cell_W
  .Range(St_R, St_R.Offset(5, 23)).RowHeight = Cell_H

  St_T = St_R.Top
  St_L = St_R.Left
  Total_W = St_R.Width * 24

  For i = 0 To 23
    St_R.Offset(-1, i).Value = i
  Next i
  .Range(St_R.Offset(-1, 0), St_R.Offset(-1, 23)).HorizontalAlignment = xlLeft
  
End With

'オートシェイプ作成
With Worksheets("Data")

  r = .Range("A65536").End(xlUp).Row
  
  Shp_r = -1: Room = 0 '補正値
  
For i = 2 To r
  If .Cells(i, 3).Value = Ans Or .Cells(i, 5).Value = Ans Then

  If Room <> .Cells(i, 2).Value Then
    Room = .Cells(i, 2).Value
    Shp_r = Shp_r + 1
    Shp_T = (Cell_H * Shp_r) + Gap_T + St_T
    St_R.Offset(Shp_r, -1) = "部屋No." & Room
  End If
  
  
  If WorksheetFunction.Even(i) = i Then
    Shp_Cl = 13
  Else
    Shp_Cl = 11
  End If
  
  If .Cells(i, 3).Value = Ans Then
    In_T = .Cells(i, 4).Value
  Else
    In_T = 0
  End If
    
  If .Cells(i, 5).Value = Ans Then
    Out_T = .Cells(i, 6).Value
  Else
    Out_T = 1
  End If
   
  
  Shp_L = In_T * Total_W + St_L
  Shp_W = (Out_T - In_T) * Total_W
  
  Set MyShp = Tar_Sh.Shapes.AddShape(msoShapeRectangle, Shp_L, Shp_T, Shp_W, Shp_H)
  
  With MyShp.Fill
    .ForeColor.SchemeColor = Shp_Cl
    .Visible = msoTrue
    .Solid
  End With
  
  Set MyShp = Nothing
  
  End If
  
Next i


End With


Set Tar_Sh = Nothing

End Sub

【37741】Re:入退出一覧表を作りたいです(結構複...
質問  rinn  - 06/5/17(水) 16:34 -

引用なし
パスワード
   ▼ichinose さん:
こんばんは。
本当に本当に助かりました。
ありがとうございます。
ichinose さんにいただいたソースをちょっと加工して使ってみるとうまくいきました。
結構理想に近いものです。
内容もだいぶ理解できたので加工することもできました。

そこでここまできたらもうひとつお願いがありますので聞いていただけませんか?
実はそのオートシェイプで作った一覧表ですが、何度も再表示をさせたいので表示させる時に前回のデータがあれば全部削除したいと考えています。

mainの最初に

ActiveSheet.Shapes.SelectAll
Selection.Delete

と記述し、オートシェイプ全部選択して削除という方法でいけるかと思ったのですが、
「メモリが不足しています」
とエラーが出ます。
何かいい対処方法はありませんか?

頼りっきりですいません。。。

【37742】Re:入退出一覧表を作りたいです(結構複...
お礼  rinn  - 06/5/17(水) 16:35 -

引用なし
パスワード
   ▼ハチ さん:
こんばんは。
ありがとうございます。
まだちゃんとソースを見れていませんが、今後のためになりそうですので解析させていただきたいと思います。

【37743】Re:入退出一覧表を作りたいです(結構複...
発言  rinn  - 06/5/17(水) 16:41 -

引用なし
パスワード
   ▼ichinose さん:

ひとつ言うのを忘れていました。
このソースはシートにボタンを作成し、ボタンクリックでマクロがはしるという風にしています。
なので私が先程記入した

ActiveSheet.Shapes.SelectAll

だとボタンまで選択されてしまいます。
やはり全く別の方法を考えなくてはいけないのでしょうか?

【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コードと基データも分けてしまいますけどね!!

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

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


以上です。

【37771】Re:入退出一覧表を作りたいです(結構複...
お礼  rinn  - 06/5/18(木) 15:47 -

引用なし
パスワード
   ▼ichinose さん:
こんにちは。

よく調べてみるとオートシェイプはメモリを大量に消費する為にあのようなエラーが出るようです。

ichinose さんの提案どおりにしたいのですが、別シートのデータを利用して日付やその他のデータを表示させていますし、表のテンプレートを作成している為にできればその体裁をくずしたくないので、同ブックに作成したいと思っています。

今回のプログラムは研修用でこれが実務で使用されるわけではありませんので、実務向きではないですがこの件は課題として置いておきたいと思います。

とにかく今回のプログラムをExcelVBAで作成するのには無理があるというのはわかっていましたので、別の言語で今回の課題はクリアできたらと思います。

色々と教えてくださり本当に助かりました。ありがとうございました。

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

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

>よく調べてみるとオートシェイプはメモリを大量に消費する為にあのようなエラーが出るようです。
Shapeは、オブジェクトですからリソース消費はあるでしょうねえ!!

>
>ichinose さんの提案どおりにしたいのですが、別シートのデータを利用して日付やその他のデータを表示させていますし、表のテンプレートを作成している為にできればその体裁をくずしたくないので、同ブックに作成したいと思っています。
この二つについては、ブックを分けても実現できますけどね!!

でも、あきらめてしまったのであれば仕方ありません。


私も一年前に作成したコードのデバッグをすることができました。
(いくつか修正点もあってより完成度が高まったので収穫でした)

【37813】Re:入退出一覧表を作りたいです(結構複...
お礼  rinn  - 06/5/19(金) 9:53 -

引用なし
パスワード
   ▼ichinose さん:
おはようございます。

ブックを分けても実現可能ということですので今から色々調べてみてやり直してみます。
プログラム用と表示用とデータ用などと分けるときっとメモリ消費も少なくなるのでしょうね。
何しろ初心者なので、自分の力でどこまでできるかと、どこまでが実現可能なのかがわからなくて・・・
あと1週間でこの課題は仕上げなければいけませんので、あとはできる限り自分の力でやってみたいと思います。

このたびはありがとうございました。
またお世話になると思いますのでそのときはよろしくお願いします。

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