get_center_cell_of_shape.vb

Function get_center_cell_of_shape(s As Shape) As Range
    Dim center_x As Double: center_x = s.Left + s.Width / 2
    Dim center_y As Double: center_y = s.Top + s.Height / 2
    
    Dim r As Range: Set r = s.TopLeftCell
    
    Do Until r.Left <= center_x And center_x <= r.Left + r.Width
        Set r = r.Offset(columnoffset:=1)
    Loop
    
    Do Until r.Top <= center_y And center_y <= r.Top + r.Height
        Set r = r.Offset(rowoffset:=1)
    Loop
    
    Set get_center_cell_of_shape = r
End Function