[[20091106222909]]　『棚割りソフト』（みさ）　ページの最後に飛ぶ

『棚割りソフト』（みさ）

 スーパーマーケットの商品バイヤーをしています。
 商品の棚割りをエクセルを使いあらかじめパックのサイズなどを全て登録しておくと
 簡単に棚割りが作成できるものを作りたく相談なのですが良い知識ありましたら教えてください。

 > 棚割りが作成できるもの

 全く名案はありませんが、何かイメージはないのでしょうか？
 簡単に検索すると、以下のようなものとか？
http://www.hisakane.co.jp/tana.htm

 (とおりすがり)

 こちら↓の「Seek」が使えるかもしれません。

http://supermab.com/

 もともとは、必要な材料を切り出すのに一番効率的な
 割付を検索するものですが、棚割りにも使えるかも
 しれません。

 ※はずしていたらすみません。
   また、このソフトは一次元のみです。２次元、３次元
   には対応してません。
 (MARBIN)

とおりすがりさんMARBINさん返事おそくなりました。回答有難うございました。理想はオートシェイプであらかしめ指定したサイズを
作成しておいていくつものサイズがあり作成してあるものを番号検索して目的の画面に作製オートシェイプを呼び出す感じが理想ですがこれに近い方法がありましたら教えてください。（みさ）

 ＞番号検索して
 の「番号」と言うのは何をイメージして居られるのでしょう？

 例えば、新しいブックのSheet2にオートシェイプで四角を３つ書きます。
 マクロの記録を実行して、作成した四角を順に選択すると
 以下のようなコードが記録されます。
Sub Macro1()
    ActiveSheet.Shapes("Rectangle 1").Select
    ActiveSheet.Shapes("Rectangle 2").Select
    ActiveSheet.Shapes("Rectangle 3").Select
End Sub

 この時の「Rectangle 1」「Rectangle 2」「Rectangle 3」が
 書いて居られる「番号」と言う事でしょうか？
 　つまり、オートシェイプの名前。

 この状態のシートを作って於くなら
 例えば、Sheet1で以下のマクロを実行してみて下さい。

 '------
Sub Test1()
Dim i As Variant
i = Application.InputBox("1～3の値を指定して下さい。", Type:=1)
    If 0 < i And i < 4 Then
        Sheets("Sheet2").Shapes("Rectangle " & i).Copy
        ActiveSheet.Paste
    Else
        MsgBox "入力した値が不正です。"
    End If
End Sub
 '------

 こんな感じで、Sheet2の　指定された名前のオートシェイプを
 貼り付ける事が出来ます。

 実際には、もっと色々な処理が
 必要に成ってくるとは思いますが。。。

 (HANA)

HANAさん回答有難うございます。理想にかなりちかいです。この方法でコピーした
オートシェイプで四角を今は指定したセルのやや右側に貼り付けられますがこの貼り付ける場所は指定できませんか？たとえばセルに合わせた所から四角の左下の角に合わせるのは無理でしょうか？（みさ）

 それらの部分が
 ＞実際には、もっと色々な処理
 の部分なのですが。。。
 （他にエラー処理とかも）

 色々な事は出来ると思います。
 この辺りとか、基本的な部分だと思いますので
 確認しておかれても良いかもしれません。
http://www.asahi-net.or.jp/~zn3y-ngi/YNxv212.html

 他にも沢山色々な事が出来ますので、やりたいことがあったら
 出来ると信じてググって見られても良いと思います。

 ただ、私が想像する所だと
 二つ目の図形は　セルの左端ではなく
 一つ目の図形の隣に寄り添わせて配置するのでないかと思いますので
 図形の調整(R)→位置合わせ(S)で「図形(S)」を選んでおいて
 くっつけたい図形の側に持っていくのが
 良いのではないかと思いますが。。。

 セルが小さな升目状にしてあって
 隣とぴったりはくっつけないのかな。。。？

 てきと～なコードですが
 こんな感じ？

 '------
Sub Test2()
Dim i As Variant, mr As String
    If TypeName(Selection) <> "Range" Then
        MsgBox "貼り付けるセルを選択して実行してください。"
    Else
        i = Application.InputBox("1～3の値を指定して下さい。", Type:=1)
        If 0 < i And i < 4 Then
            mr = ActiveCell.Address
            Sheets("Sheet2").Shapes("Rectangle " & i).Copy
            ActiveSheet.Paste
            With Selection
                .Top = Range(mr).Offset(1).Top - .Height
                .Left = Range(mr).Left
            End With
        Else
            MsgBox "入力した値が不正です。"
        End If
    End If
End Sub
 '------

 あ、「後で移動」とかありそうなら
 図形の調整(R)→位置合わせ(S)
 の設定は、やっておくと便利かもしれません。

 念のため、こちらもリンクしておきます。
[[20061104163708]]『指定サイズでの印刷』（たぼん）

 (HANA)

HANAさんたびたび回答有難うございます。セルが小さな升目状にしてあって隣とぴったりはくっつけないのかな。。。？
そうになってます。一つ目の図形の隣に寄り添わせて配置するのですが前回だと合わせたセルに貼り付けでしたがこれを必ず前回貼り付けた図形の下揃えの隣に自動で貼り付けは可能なのでしょうか？
質問がまとまらず何度も質問してしまいすみません。（みさ）

 もう一つ作ってみました。

 '------
Sub Test3()
Dim i As Variant, x As Double, y As Double
i = Application.InputBox _
        ("1～3の値を指定して下さい。" & vbLf & _
        "最後に「-」をつけると、左に並びます。", Type:=2)
i = StrConv(i, vbNarrow)
    If 0 < Val(i) And Val(i) < 4 Then
        If TypeName(Selection) = "Range" Then
            With ActiveCell
                x = .Offset(, IIf(Right(i, 1) = "-", 1, 0)).Left
                y = .Offset(1).Top
            End With
        Else
            With Selection.ShapeRange
                x = .Left + IIf(Right(i, 1) = "-", 0, .Width)
                y = .Top + .Height
            End With
        End If
            Sheets("Sheet2").Shapes("Rectangle " & Val(i)).Copy
            ActiveSheet.Paste
            With Selection.ShapeRange
                .Left = x - IIf(Right(i, 1) = "-", .Width, 0)
                .Top = y - .Height
            End With
    ElseIf i <> "False" Then
        MsgBox "入力した値が不正です。"
    End If
End Sub
 '------

 実行前にセルが選択されていたら、
 　選択していたセルの左下と貼り付けた図形の左下を合わせます。
 　　　【新図形】ル]　（左詰でセルの上に重なります）
 実行前に図形が選択されていたら、
 　選択していた図形の右下と貼り付けた図形の左下を合わせます。
 　　　 [図形]【新図形】

 例えば「1-」の様に最後にマイナスをつけて入力した場合
 実行前にセルが選択されていたら、
 　選択していたセルの右下と貼り付けた図形の右下を合わせます。
 　　　 [セ【新図形】　（右詰でセルの上に重なります）
 実行前に図形が選択されていたら、
 　選択していた図形の左下と貼り付けた図形の右下を合わせます。
 　　　【新図形】[図形]

 因みに、この掲示板ですが
_←ここの所に半角スペースを入れると
 改行がそのまま表示されるようになります。
 プレビュー画面でご確認頂ければと思います。

 (HANA)

 MARBIN さん

 はじめまして、supermab と申します。
 Seekをご紹介いただきありがとうございます m(_ _)m

 みささん

 これは、組合せ最適化問題の、ナップサック問題という問題と同じ問題です。
 せっかく、MARBIN さんにご紹介いただいたので、棚割用のExcelブックを作ってみまし た。
 棚割のことは全く判りませんので、たたき台にでもなればと思います。

 ダウンロードはこちらからどうぞ↓

http://supermab.com/files/shelf.zip

 棚の幅、商品名、商品の幅、価値（重みを示す）を入力してから、計算実行ボタンを
 押すと、マクロが動作します。
 マクロは、与えられたデータを整数混合線形計画問題に置換して
 同梱してあるフリーの線形解析ライブラリlpsolve55.dll を呼んで解析いたします。

 よろしければ、ご利用ください。

 (supermab)

HANAさん大変素晴らしいマクロを書いていただき有難うございました。自分の思う動きです。
このマクロを利用させていただきます。大変ありがとうございました。
supermabさんの教えていただいたソフトも参考にさせてもらいます。
大変お世話になりました。（みさ）

問題がおきてしまいました。エクセル2003だとうまくいくのですが2007だとPictureこのマクロがエラーになってしまいました。
Dim i As Variant, x As Double, y As Double
i = Application.InputBox _

        ("1～500の値を指定して下さい。" & vbLf & _
        "最後に「-」をつけると、左に並びます。", Type:=2)
i = StrConv(i, vbNarrow)
    If 0 < Val(i) And Val(i) < 500 Then
        If TypeName(Selection) = "Range" Then
            With ActiveCell
                x = .Offset(, IIf(Right(i, 1) = "-", 1, 0)).Left
                y = .Offset(1).Top
            End With
        Else
            With Selection.ShapeRange
                x = .Left + IIf(Right(i, 1) = "-", 0, .Width)
                y = .Top + .Height
            End With
        End If
            Sheets("倉庫").Shapes("Picture  " & Val(i)).Copy
            ActiveSheet.Paste
            With Selection.ShapeRange
                .Left = x - IIf(Right(i, 1) = "-", .Width, 0)
                .Top = y - .Height
            End With
    ElseIf i <> "False" Then
        MsgBox "入力した値が不正です。"
    End If
End Sub
この部分でエラーになりますSheets("倉庫").Shapes("Picture  " & Val(i)).Copy
どうしたらえらーを回避できますか？
同じくこのマクロもエラーになります。

With Selection

        ActiveSheet.Shapes.AddTextbox( _
            Orientation:=msoTextOrientationHorizontal, _
            Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Select
    End With
    Dim buf As String
buf = InputBox("テキスト編集を起動します。" & vbNewLine & "閲覧の方はキャンセルを押してください ")
     If buf = "Text Box" Then Exit Sub
     Selection.Characters.Text = buf

    With Selection.Font
        .Name = "HG創英角ｺﾞｼｯｸUB"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .ReadingOrder = xlContext
        .Orientation = xlHorizontal
        .AutoSize = False
        .AddIndent = False
     End With
 End Sub
おしえてもらえないでしょうか？宜しくおねがいします。（みさ）

 下の方は分かりませんが
 上の物は、2007で試してみましたが
 別に問題なく動く様です。

 エラーメッセージは、どの様な物が表示されますか？
 「指定したアイテムが見つかりませんでした。」
 であれば、付けてある名前の数字部分が
 全角数字で入力されて居ないか、確認してみてください。

 (HANA)

Picture 以外は正常に動作しますが写真が（Picture ）となった時エラーになります。
Sheets("倉庫").Shapes("Picture " & Val(i)).Copy
オートメーションエラー（Error440)と出ます。（みさ）

 う～ん、こちらでは出ないので何とも言いづらいのですが。。。

 メッセージは違いますが、取りあえずこんなのがありましたので
http://support.microsoft.com/kb/971594/ja
 　　Excel 2007 でマクロ機能やオートメーション機能を使用すると、
 　　"メモリ不足です。完全に表示できません" と表示されて操作ができなくなる
 確認してみて下さい。

 ちなみに、私の2007はSP2です。

 左上のボタン（Officeボタン）を開いて
 下の方に「Excelのオプション(I)」がありますので、それをクリックして
 左側の矢張り下の方に「リソース」がありますので、選択すると
 右側の下の方に、バージョンが表示されます。

 (HANA)

ちなみに、私の2007はSP2です。こちらも同じ2007はSP2と表示されてます。写真Picture は図をファイルから挿入の項目から画像を貼り付けた物ですがこれでいいのですよね？この画像のみがエラーになつてます？（みさ）

 同じように図を挿入してみましたが、エラーは出ず。。。

 ＞この画像のみがエラーになつてます？
 と言うのは
 　オートシェイプならＯＫだけど、挿入した図はＮＧ
 と言う事でしょうか？それとも
 　いくつか図を挿入しているが、一つの画像だけＮＧ
 と言う事でしょうか？

 面倒ですが、オートシェイプの塗りつぶしとして
 その画像を指定してみると　どうでしょう。

 解決策ではなく「何とかして動かせる方法を探す」感じに成ってしまいますが。。。

 画像が外に保存してあるなら、直接読み込むコードを
 検討した方が良いのかもしれません。

 (HANA)

エクセルのファイルに画像の大きさなどを設定したあるのでこの方法でいきたいのですがだめでしょうか？色々ためしましたがどうしても写真のPicture のみがでめなようです。2003だとちゃんとうごきます。こうなるとわかりませんか？（みさ）

 すみません。
 全く分かりません。

 後学の為に教えて下さい。

 ＞色々ためしましたが
 の中に
 ＞＞オートシェイプの塗りつぶしとしてその画像を指定
 も含まれていますか？

 あとは、例えば　すごい軽い画像を使ってみるとか。。。

 (HANA)

2003です。Sheets("倉庫").Shapes("Picture " & Val(i)).Copy
2007です。Sheets("倉庫").Shapes("Picture " & Val(i)).Copy
返事遅れました。
色々試して半角スペースを抜いたらうごきました。こんなのありですか？（みさ）

 えっと。。。
 なんかずれてますね。

 まぁ、コピー出来るように成った様で良かったです。

 ＞半角スペースを抜いたらうごきました。
 これって
 　Picture の後ろに半角スペースが二つ入っていたのを
 　半角スペース一つにした
 って事ですか？

 それで動くように成ったのなら　それが問題だったのかもしれませんね。。。

 因みに、画像名はエクセル任せになってしまいますが
 HTML形式で保存すると
 一緒に出来る ブック名.filesと言うフォルダの中に
 それぞれの画像が保存されます。

 大きさを変更した図を、別の所で使用したい　等と言った場合に
 知っておくと、何かの役に立つかもしれません。

 それから、もう一つのコードの方は
 何をしたいコードなのか
 説明が有ると良いと思います。
 　エラーが出る場所と、エラーメッセージも合わせて。

 (HANA)

お手数おかけします。しばらく悩んだ結果だったのでなんとも原因がいまいちでしたのですが・・・・
さらにHANAさんにおしえてもらったHTML形式で保存するとを知りたいのですが・・・
それともう一個は

 ActiveSheet.Shapes.AddTextbox( _
            Orientation:=msoTextOrientationHorizontal, _
            Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Select
    End With
    Dim buf As String
buf = InputBox("テキスト編集を起動します。" & vbNewLine & "閲覧の方はキャンセルを押してください ")
     If buf = "Text Box" Then Exit Sub
     Selection.Characters.Text = buf

    With Selection.Font
        .Name = "HG創英角ｺﾞｼｯｸUB"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .ReadingOrder = xlContext
        .Orientation = xlHorizontal
        .AutoSize = False
        .AddIndent = False
     End With
なんとなくの結果ですが.ReadingOrder = xlContextを削除したらうごきだしました。
（みさ）

 そうですね。。。
 たぶん、その設定が変わることは無いと思いますので
 設定しなくても大丈夫だと思います。
 （ずいぶん勝手なこと言いますが。）

 とにかく、動くようになって良かったです。＾＾

 HTML形式で保存　と言うのは・・・

 エクセルで名前を付けて保存するときの
 ファイル名(N)　を入れる所の下に
 ファイルの種類(T)　を選べるように成っていますが
 そこで、例えば「Webページ (*.html;*.html)」
 を選んで保存してみて下さい。

 例えば、ファイル名を「Book1」とした場合
 Book1.htm と言うファイルと一緒に
 Book1.files と言う【フォルダ】が出来ます。
 その中に、画像がファイルとして保存されています。
 　重なった物は、重なった状態で保存されるので注意して下さい。

 そのファイルには他のシートに画像がコピー済みと思いますので
 倉庫シートを選択した状態で「選択範囲(E):シート」の方を選んで
 保存してみるのが良いかもしれません。

 後は、過去ログにファイル名を変更するマクロとか有るので
 そう言った物も活用できるかもしれません。

 (HANA)

色々と今回も大変お世話になりました。ちょっとまたこのHTML形式で保存とやらを勉強します。
またわからない事ありましたら教えてください。（みさ）

コメント返信：

[ 一覧(最新更新順) ]

[[20091106222909]] 『棚割りソフト』（みさ） ページの最後に飛ぶ

[[20091106222909]]　『棚割りソフト』（みさ）　ページの最後に飛ぶ