如何根据单元格宽度更改形状的大小

Question

如何根据单元格宽度更改形状的大小

例如，我的单元格 B1 的宽度为：14:00（103 像素），C1 的宽度为：16:00（117 像素）。放置在 Rage 内的形状应将其大小更改为 220 像素。

而且每当宽度发生变化时，它都应该根据其大小进行调整！所以应该有一个方法来查找单元格宽度。

我拥有的代码将帮助我将其居中

Sub Set_shape()

ActiveSheet.Shapes("Rectangle 1").Select 'get the object
With Selection
    .Left = Range("B1:C1").Left + (Range("B1:C1").Width - Selection.Width) / 2
    .Top = Range("B1:C1").Top + (Range("B1:C1").Height - Selection.Height) / 2
End With

End Sub

是否可以？如果是的话请帮我修改这段代码？

提前致谢

Answer 1

如果想法是使形状与给定范围完全相同，那么可以这样做：

Option Explicit

Sub SetShape()

    Dim rect1           As Shape
    Dim rngToCheck      As Range

    With ActiveSheet
        Set rect1 = .Shapes("Rectangle 1")
        Set rngToCheck = .Range("B1:C1")
    End With

    With rect1
        .Left = rngToCheck.Left
        .Top = rngToCheck.Top
        .Width = rngToCheck.Width
        .Height = rngToCheck.Height
    End With
End Sub

这就是你会得到的：

好的部分是，如果更改单元格的大小，默认情况下形状也会更改：

如果你想在形状周围放置一些边框，可以像这样玩：

Sub SetShape()

    Dim rect1           As Shape
    Dim rngToCheck      As Range
    Dim borderSize      As Double

    borderSize = 0.9

    With ActiveSheet
        Set rect1 = .Shapes("Rectangle 1")
        Set rngToCheck = .Range("B1:C1")
    End With

    With rect1
        .Width = rngToCheck.Width * borderSize
        .Height = rngToCheck.Height * borderSize
        .Left = rngToCheck.Left + (.Width / 2) * (1 - borderSize)
        .Top = rngToCheck.Top + (.Height / 2) * (1 - borderSize)
    End With

End Sub

在本例中，边框指定为 a borderSize，结果如下：