ほっとひといき給湯室

ほっとひといき給湯室の掲示板です。お気軽にどうぞ!
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
【お礼】セルにシェイプがあるか?ないか?
投稿日時: 17/10/16 08:33:13
投稿者: montaU

隠居じーさん様、 ピンク様、WinArrow様
 
なんとか動作するところまでこぎつけました。
どうもありがとうございました。
 
とりあえずメインの部分だけ。
※多少仕様変更して、2列×13行、長方形シェイプは60個ほど。
 
基本的に動けばいいさ!なので、未熟故に冗長さは自分で納得してるし、エラー処理等は後から肉付けです(エラーが出てから対処w)。
 
Private Sub CommandButton1_Click()
 
    If Me.OptionButton1.Value = False And Me.ListBox1.ListIndex = -1 Then
        MsgBox "処理を選択して下さい。"
        Exit Sub
    End If
 
    Set ws = ThisWorkbook.Worksheets("**")
    With ws
        If Me.OptionButton1.Value = True Then
            simei = Application.Caller
            ret_Top = .Range(s_place(simei)(1)).Top
            ret_Left = .Range(s_place(simei)(1)).Left
            .Shapes(simei).Top = ret_Top
            .Shapes(simei).Left = ret_Left
        Else
            m = 4
            j = Me.ListBox1.ListIndex * 2 + 2
            For Each myShp In .Shapes
                If Not Intersect(myShp.TopLeftCell, _
                           .Range(.Cells(5, j), _
                           .Cells(17, j))) Is Nothing Then
                    m = m + 1
                    If m > 17 Then
                        myShp.Top = .Cells(m - 12, j + 1).Top
                        myShp.Left = .Cells(m - 12, j + 1).Left
                    Else
                        myShp.Top = .Cells(m, j).Top
                        myShp.Left = .Cells(m, j).Left
                    End If
                End If
            Next
            If m >= 17 Then
                m = 4
                For Each myShp In .Shapes
                    If Not Intersect(myShp.TopLeftCell, _
                                 .Range(.Cells(5, j + 1), _
                                 .Cells(17, j + 1))) Is Nothing Then
                        m = m + 1
                        myShp.Top = .Cells(m, j + 1).Top
                        myShp.Left = .Cells(m, j + 1).Left
                    End If
                    mTop = .Cells(m + 1, j + 1).Top
                    mLeft = .Cells(m + 1, j + 1).Left
                Next
            Else
                mTop = .Cells(m + 1, j).Top
                mLeft = .Cells(m + 1, j).Left
            End If
            .Shapes(simei).Top = mTop
            .Shapes(simei).Left = mLeft
            .Range("b5:i17").Interior.ColorIndex = xlNone
        End If
    End With
    Set ws = Nothing
    Unload Me
End Sub
 
とりあえずはお礼まで、ありがとうございました。
※ダメ出し期待して、今日一日ぐらい明けときます、今日中、もしくは明日朝に閉じさせていただきます。

回答
投稿日時: 17/10/16 12:20:35
投稿者: mattuwan44

ども^^
 
何をしたいかコードを読むだけではよくわかりません。
特にリストボックスの説明がない。
 
日本語で処理の流れを説明できませんか?
 
だめだしということなら、
斜め読みしかしてないけど、変数の宣言はちゃんとしましょう。
 
http://officetanaka.net/excel/vba/beginner/06.htm
http://www.accessclub.jp/vba/vba_016.htm
http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_200_030.html
http://www.239-programing.com/excel-vba/basic/basic032.html

回答
投稿日時: 17/10/16 12:23:59
投稿者: mattuwan44

>.Range(s_place(simei)(1))
 
あと、セルに図形に対応する名前を付けているってことですか?

投稿日時: 17/10/16 12:35:39
投稿者: montaU

mattuwan44様
 
ご対応ありがとうございます。
 
このスレの流れでということでした。
http://www.moug.net/faq/viewtopic.php?t=76302
 
変数の宣言へのご指摘、ありがとうございます。
(そうですね、全体をアップしにくいので)
 
 

投稿日時: 17/10/16 16:03:33
投稿者: montaU

隠居じーさん様、 ピンク様、WinArrow様
 
どうもお世話になりました、ありがとうございました。
閉じます。