Question

请高手帮忙，万分感谢！Excel vba 1.在工作表中插入-形状-矩形。2.用鼠标拖动矩形移动

请高手帮忙，万分感谢！Excel vba 1.在工作表中插入-形状-矩形。2.用鼠标拖动矩形移动，鼠标未松开，根据矩形左下脚所在单元格大小自动调整矩形大小。3.松开鼠标后，矩形填充在左下脚所在单元格。

Answer 1

有一个问题，就是用插入的矩形来查找其左下角的单元格不太好定位，最起码我是不会。
如果已知是哪一个单元格，给矩形定位的话，那就简单多了。

建议你用office里的project软件，更是一目了然。

Answer 2

你为什么不直接选择单元格，然后调整矩形的大小和单元格大小一致。
而是先插入矩形，然后拖动矩形到指定单元格（这样还要判断左下角的单元格地址），然后再调整大小呢?

追问

不同行表示生产线，列单元格表示日期，矩形框会跨多个单元格，标识可生产到哪天，后面会根据条件判断，我先要基础功能，谢谢了

追答

Sub Macro2()
With Selection(1)
Set my = ActiveSheet.Shapes.AddShape(1, .Left, .Top, .Width, .Height)
End With
End Sub
不知道这样行不行。。选中一个单元格，然后运行。

追问

sorry,要鼠标拖动变化才行，用其他控件，图表等也行啊，谢谢了

追答

Sub aaa()
    Static r As Rectangle
    If TypeName(Selection) = "Rectangle" Then
        Set r = Selection
    Else
      If Not r Is Nothing Then
            Dim rng As Range
            Set rng = Cells(r.BottomRightCell.Row, r.TopLeftCell.Column)
            r.Left = rng.Left
            r.Top = rng.Top
            r.Width = rng.Width
            r.Height = rng.Height
            Set r = Nothing
        End If
    End If
    Application.OnTime Now() + TimeValue("00:00:01"), "aaa", , True
End Sub

先运行代码，然后插入矩形，拖动，最后选择任意一个单元格。如上图

追问

鼠标拖动矩形不变，松开不变，点选其他后才变，不能随鼠标的移动变化吗

追答

这还是折中的办法，因为移动的时候ontime是不能运行的。。看有没有高手能实现你的想法，我也学习学习