请教，如果使用代码调整形状的位置？

NieC

我有一张工具表，原始内容是空的，只有2个按钮，已经写好一些统计订单类型的代码，导入数据后会生成结果。

因为每天产生的类型种类是不一致的，，少的时候只有2-3个，多的话十几个，按钮的位置就不好放，靠前的话可能会遮挡内容，太靠右的话中间又会很空。
所以希望这2个按钮的位置能根据具体内容调整，但是搜了下没找到设置按钮位置的代码，我录了宏，发现也没有记录位置信息。找到一些代码都是新建时候设置的位置。所以还是希望大佬们给些指点，谢谢了！

lcluck2002

录制了一段宏，试着修改了一下，可以根据单元格位置来确定矩形框的位置，参考一下：

micch

shapes("name").top=range("**").top

tanglf188

把代码粘贴在Sheet1下，自动执行。
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 Then Exit Sub
    Set findcell = Sheet1.Cells.Find("日期", LookAt:=xlWhole)
    If Not findcell Is Nothing Then
        daterow = findcell.Row
        Sheet1.Shapes.Range(Array("Rectangle 1")).Left = Sheet1.Cells(findcell.Row, findcell.Column).Offset(1, 2).Left
        Sheet1.Shapes.Range(Array("Rectangle 1")).Top = Sheet1.Cells(findcell.Row, findcell.Column).Offset(1, 2).Top
        Sheet1.Shapes.Range(Array("Rectangle 2")).Left = Sheet1.Cells(findcell.Row, findcell.Column).Offset(1, 2).Left
        Sheet1.Shapes.Range(Array("Rectangle 2")).Top = Sheet1.Cells(findcell.Row, findcell.Column).Offset(1, 2).Top + 25
    End If
End Sub

NieC

lcluck2002 发表于 2023-1-17 11:43
录制了一段宏，试着修改了一下，可以根据单元格位置来确定矩形框的位置，参考一下：

感谢回复。我的wps录制只有下面的内容

Sub Macro1()
'
' Macro1 Macro
' 宏由 28916 录制，时间: 2023/01/17
'

'
    Selection.ShapeRange.Select Replace:=False
    Selection.ShapeRange.Select Replace:=False
End Sub

NieC

micch 发表于 2023-1-17 12:29
shapes("name").top=range("**").top

感谢回复。实测出错

NieC

tanglf188 发表于 2023-1-17 12:41
把代码粘贴在Sheet1下，自动执行。
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target ...

感谢回复。实测放在sheet1下不会自动运行，但是我找到关键语句
       Sheet1.Shapes.Range(Array("Rectangle 1")).Left = Sheet1.Cells(findcell.Row, findcell.Column).Offset(1, 2).Left

图形操作我之前写的shapes("Rectangle 1"")，结果无法运行，改用上述方式可用，多谢！

zhw79

这不需要代码吧，直接设置下就可以了

tanglf188

zhw79 发表于 2023-1-17 14:40
这不需要代码吧，直接设置下就可以了

这个只能方法有一个缺陷，就是选中的单元区域在形状的范围内，改形状也会被选中，整个形状就会变形，用第三个选项配合代码就能避免这点

aman1516

试试：

1. Private Sub Worksheet_Activate()
   
2. Dim shp As Shape, rng As Range
   
3. For Each shp In Sheet1.Shapes
   
4.     Select Case shp.Name
   
5.        Case "矩形 1"
   
6.           Set rng = Range("IV1").End(xlToLeft).Offset(0, 1)
   
7.           Shapes("矩形 1").Top = rng.Top
   
8.           Shapes("矩形 1").Left = rng.Left
   
9.        Case "矩形 2"
   
10.           Set rng = Range("IV2").End(xlToLeft).Offset(0, 1)
    
11.           Shapes("矩形 2").Top = rng.Top
    
12.           Shapes("矩形 2").Left = rng.Left
    
13.        Case "矩形 3"
    
14.           Set rng = Range("IV7").End(xlToLeft).Offset(0, 1)
    
15.           Shapes("矩形 3").Top = rng.Top
    
16.           Shapes("矩形 3").Left = rng.Left
    
17.        Case "矩形 4"
    
18.           Set rng = Range("IV8").End(xlToLeft).Offset(0, 1)
    
19.           Shapes("矩形 4").Top = rng.Top
    
20.           Shapes("矩形 4").Left = rng.Left
    
21.     End Select
    
22. Next
    
23. Set rng = Nothing
    
24. End Sub
    

复制代码