تغییر اندازه یک جعبه متن در یک ماکرو

Question

Rob یک جعبه متن در یک کاربرگ دارد که حاوی متن کپی شده از Word است. او می خواهد بداند که چگونه می تواند با استفاده از یک ماکرو اندازه جعبه متن را تغییر دهد تا محدوده خاصی از سلول ها را پوشش دهد.

چند راه وجود دارد که می توانید به این کار نزدیک شوید. یکی این است که در ماکرو مشخص کنید که دقیقا کدام سلول ها را می خواهید با کادر متن بپوشانید و سپس ویژگی های جعبه متن را مطابق با ویژگی های سلول هایی که مشخص کرده اید تنظیم کنید.

Sub ResizeBox1()
    Dim sTL As String
    Dim sBR As String
    Dim rng As Range

     Change top-left and bottom-right addresses as desired
    sTL = "A1"
    sBR = "M40"

     Ensure a text box is selected
    If TypeName(Selection) <> "TextBox" Then
        MsgBox "Text box not selected"
        Exit Sub
    End If

    With Selection
        Set rng = ActiveSheet.Range(sTL)
        .Top = rng.Top
        .Left = rng.Left
        Set rng = ActiveSheet.Range(sBR)
        .Width = rng.Left + rng.Width
        .Height = rng.Top + rng.Height
    End With
    Set rng = Nothing
End Sub

برای استفاده از ماکرو، آدرس سلول هایی را که می خواهید برای بالا سمت چپ و پایین سمت راست کادر متن استفاده کنید، تغییر دهید. سپس کادر متن را انتخاب کرده و ماکرو را اجرا کنید.

اگر ترجیح می دهید، می توانید از یک محدوده نام گذاری شده برای تعیین محدوده تحت پوشش کادر متن استفاده کنید. ماکرو زیر انتظار دارد که محدوده به نام RangeToCover باشد. وقتی کادر متنی را انتخاب می کنید و ماکرو را اجرا می کنید، اندازه جعبه متن برای مطابقت با اندازه محدوده تغییر می کند.

Sub ResizeBox2()
    Dim l_rRangeToCover As Range
    Dim l_rLowerRight As Range

     Ensure a text box is selected
    If TypeName(Selection) <> "TextBox" Then
        MsgBox "Text box not selected"
        Exit Sub
    End If

     Get the range to cover
    Set l_rRangeToCover = _
      ActiveSheet.Range(Names("RangeToCover").RefersToRange.Value)

     Get its lower right cell
    Set l_rLowerRight = _
      l_rRangeToCover.Cells( _
      l_rRangeToCover.Rows.Count, _
      l_rRangeToCover.Columns.Count)

     Resize the text box
    With Selection
        .Left = l_rRangeToCover.Left
        .Top = l_rRangeToCover.Top
        .Width = l_rLowerRight.Left + l_rLowerRight.Width - .Left
        .Height = l_rLowerRight.Top + l_rLowerRight.Height - .Top
    End With
End Sub