如何根據單元格寬度更改形狀的大小

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給出，這是結果：