[[20081205221816]]　『オートシェイプを移動させたとき特定のセルで止ま』（CHISA）　ページの最後に飛ぶ

『オートシェイプを移動させたとき特定のセルで止まらない方法ってありますか？』（CHISA）

 またまたCHISAですm(__)m
 それでまたまたオートシェイプの質問ですm(__)m

 実は今シフト表を作っていて、
 オートシェイプを使って勤務時間を表示することにしたんですけど、
 山あり谷ありつまずきっぱなしですが、みなさんのおかげで
 なんとかあとちょっとで完成？しそうです♪♪

 シフト表はこんな感じです（オートシェイプの表示がうまくできないんですけど･･）

     1   2    3    4  　5    6
 A      17時 18時 19時 20時 21時
 B A子　 |ｵｰﾄｼｪｲﾌﾟ1|
 C
 D B子        |ｵｰﾄｼｪｲﾌﾟ2|
 E 
 F C子   |ｵｰﾄｼｪｲﾌﾟ3|
 G
 H D子                  |ｵｰﾄｼｪｲﾌﾟ4|

 表を見やすくするために行C,E,Gは高さを5ﾋﾟｸｾﾙだけにして、
 それぞれの子達の間に隙間を作っています。

 オートシェイプを移動するときは
 グリッドを使ってセルごとに移動させているんですけど、
 オートシェイプのTopの座標で
 それぞれの子達を判別するようなマクロを作ってしまったので、
 できれば行C,E,Gにオートシェイプを止めたくないんです。

 そこでなんですけど、
 例えばオートシェイプ1をA子からB子の行に移動したときとかに
 （行Bから行Dに移動するときに）
 あやまって行Cに止まったりしないようにはできないでしょうか？
「
 保護機能を使えばなんとかなるかな～って思ってたんですけど、
 ちょっとうまくいかないみたいで・・・(;へ;)

 もしそんな方法があったら教えてくださいm(__)m

 なければ、はっきり「ナイ！」と言ってくださぃ！

 説明がへたくそでいつもみなさんにご迷惑をお掛けしてますが、
 宜しくお願いします♪
 (CHISA)

 仕様としては、奇数行に図形を移動した場合は、偶数行に移動する　という仕様です。
 逆なら（偶数行に図形を移動した場合は、奇数行に移動する）、コードを解析して修正してください。

 標準モジュールに

 '=============================================================================
 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 Const ok = 2
 Sub ctrl_vert()
    Static shp As Shape
    Dim sel As Shape
    Dim svvbl As Long
    Dim svcl As Long
    Dim newrow As Long
    Dim svtop As Long
    If TypeName(Application.Caller) = "String" Then
       If Not shp Is Nothing Then
          If shp.Name = ActiveSheet.Shapes(Application.Caller).Name Then
             Exit Sub
          Else
             MsgBox "どこかのセルを選択後、改めて対象図形を選択してください"
             Exit Sub
          End If
       Else
          Set shp = ActiveSheet.Shapes(Application.Caller)
       End If
       shp.Select
       svvbl = shp.Fill.Visible
       shp.Fill.Visible = msoTrue
       svcl = shp.Fill.ForeColor.SchemeColor
       svtop = shp.TopLeftCell.Row
       On Error Resume Next
       Set sel = Selection.ShapeRange(1)
       Do While Err.Number = 0 And shp.Name = sel.Name
          If sel.TopLeftCell.Row Mod ok = 0 Then
             svtop = sel.TopLeftCell.Row
          Else
             If sel.TopLeftCell.Row - svtop > 0 Then
                sel.Top = Cells(sel.TopLeftCell.Row + 1, sel.TopLeftCell.Column).Top
             Else
                If sel.TopLeftCell.Row - 1 = 0 Then
                   newrow = 2
                Else
                   newrow = sel.TopLeftCell.Row - 1
                End If
                sel.Top = Cells(newrow, sel.TopLeftCell.Column).Top
             End If
             svtop = sel.TopLeftCell.Row
          End If
          Set sel = Selection.ShapeRange(1)
          DoEvents
          shp.Fill.ForeColor.SchemeColor = shp.Fill.ForeColor.SchemeColor Xor (svcl Xor 8)
          Sleep 300
       Loop
       shp.Fill.Visible = svvbl
       shp.Fill.ForeColor.SchemeColor = svcl
       Set shp = Nothing
    End If
    On Error GoTo 0
 End Sub

 このctrl_vertというマクロを各図形を選択　---右クリック---マクロの登録にて、登録して試して見てください。
 尚、マクロを登録すると、図形選択時の選択したという認識表示がされなくなりますので、
 図形を点滅させています。　まずは、新規ブックにて試してみて下さい。

 >グリッドを使ってセルごとに移動させているんですけど、

 であれば、この程度のコードでいけると思います。

 ichinose

 ichinoseさんこんばんわm(__)m
 いつもありがとうございます♪

 >であれば、この程度のコードでいけると思います。

 って、とってもすごぃんですけど！！
 しかもバッチリです(@v<)b♪

 ありがとうございました。
 (CHISA)

コメント返信：

[ 一覧(最新更新順) ]

[[20081205221816]] 『オートシェイプを移動させたとき特定のセルで止ま』（CHISA） ページの最後に飛ぶ

[[20081205221816]]　『オートシェイプを移動させたとき特定のセルで止ま』（CHISA）　ページの最後に飛ぶ