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

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

在这种情况下，边界以 borderSize 的形式给出。这是结果: