ITservice雄飛です。
ほんとにお久しぶりの投稿です。
今回は、Excel VBAを。
今、オブジェクト（シート上に貼り付けられた画像）のRowsを取得する関数を探していたんですが。
どうも、昔はあった様だけれども、現在は廃止になっている様で、無情にエラーが返って終了しました。
色々考えた末、セルのサイズも取得できること考えたら、それアルゴリズムに落とせば良いだけじゃん、、、という、一般的且つ、ごく普通の考えに至りました。
で、思いついたら即実装。
簡単ですね、WhileとIFと変数の加算減算だけなので。
例ではRowですが、取得する値を幾つか変えれば、Colにも対応可能ですね。
本番はLazarus（Pascal）からComObjで呼び出すので、これからそれを組みますが。
まぁ、消すには勿体ないので、ブログ記事にしました。
以下、こんな感じ、即興のテスト関数です。
※このサンプル関数では事前に、オブジェクト（Shapes）を選択（Select）している必要があります。
Function Return_Sharp_Rows(start_i As Long, end_i As Long) As Long Dim tp As Long ‘選択したオブジェクトのTop座標を格納 Dim rw As Long ‘RowsのTopの合計値を格納 Dim rw2 As Long ‘RowsのHeightの合計値を格納 Dim i_1 As Long ‘While開始位置 Dim i_2 As Long ‘While終了位置 tp = Selection.ShapeRange.Top ‘選択されたオブジェクトのTop座標を取得 rw = 0 ‘Row.Topsを初期化 rw2 = 0 ‘Row.Heightsを初期化 i_1 = start_i ‘開始位置を引数から代入 i_2 = end_i ‘終了位置を引数から代入 Return_Sharp_Rows = -1 ‘検索にヒットしなかった場合の暫定値設定 While i_1 < i_2 ‘While文開始 rw = rw + Cells(i_1, 1).Top ‘Row.Topsを代入 rw2 = rw2 + Cells(i_1, 1).Height ‘Row.Heightsを代入 If ((rw <= tp) And (rw2 >= tp)) Or (rw = tp) Then ‘オブジェクトの座標をセルの数値と比較し検証する Return_Sharp_Rows = i_1 ‘一致した場合、戻り値にセルのRow（i_1）を代入 i_2 = i_1 ‘開始位置と終了位置を同一にし、While文を終了させる End If i_1 = i_1 + 1 ‘Rowを一つ下に移す（i_1を加算する） Wend End Function呼び出すときはこうします。例です。Sub Get_Shapes_CellRow() Dim i As Integer i = Return_Sharp_Rows(1, 20) MsgBox Str(i) End Sub以上。Excelって便利ですね。