オートシェイプの中心を、指定セルの中心に合わせる

昨日、テキストボックスのサイズに合わせて、テキストボックス内の
文字サイズを自動で拡大または縮小する関数を作成した。
infoment.hatenablog.com

これでようやく次に進めると思った矢先、問題が発生した。

問題点：
Autosizeで最適なフォントサイズを探る際、オートシェイプの位置が
ずれてしまう。

例えば、こんな感じで。

色々試してみたが、どうしても動いてしまう。そこで諦めて、動いた
ものの中心を指定セルの中心に移動させる関数を作ることにした。

Function FitCenter(target_range As Range, target_shape As Excel.Shape) As Excel.Shape
    Dim w As Double
        w = target_shape.Width
    Dim h As Double
        h = target_shape.Height
    Dim T As Double
        T = target_range.Top + (target_range.Height - h) / 2
    Dim L As Double
        L = target_range.Left + (target_range.Width - w) / 2
        
        target_shape.Top = T
        target_shape.Left = L
        
    Set FitCenter = target_shape
End Function

先程のサンプルで試すと、このようになった。

Sub HogeTest()
    Dim Shape As Excel.Shape
    Set Shape = ActiveSheet.Shapes(2)
    
        TextToFitShape Shape
        FitCenter Selection, Shape
End Sub

また一歩、ゴールに近づいた。

参考まで。