Xác định tâm của shape đang thuộc ô nào

[Nhattanktnn]

Em đang viết code căn chỉnh hình ảnh trong file excel cho vừa với ô. Vấn đề căn chỉnh thì không bàn tới, nhưng em đang vướng chỗ xác định hình ảnh đó đang thuộc ô nào để chỉnh khớp ô đó. Hướng làm là xác định tâm của shape theo tọa độ (left+width/2, top+height/2) (phải xác định theo tâm vì nhiều khi top và left nó thuộc ô khác, nhưng phần lớn hình ảnh và tâm lại thuộc ô khác). Khi xác định được tâm rồi thì phải biết đó là ô nào để căn chỉnh theo top left width height của ô đó => Khúc này thì em chưa nghĩ ra, ý tưởng là tìm top và left của ô nào nhỏ hơn gần nhất --> Nhưng nghĩ vậy chứ làm thì không biết, chã nhẽ lại lặp hết ô trong sheet
Mong mọi người giúp đỡ

 

[HieuCD]

Cảm ơn các thầy và các anh chị đã giúp đỡ, em cũng tự viết ra một code thế này, không biết có sai chỗ nào nữa không. Đúng ra là em nên gom 2 vòng lặp thành 1, khi đúng X mà chưa đúng Y thì bỏ X xét tiếp Y. Nhưng em chưa làm kịp

Option Explicit

Sub CenterShapesAddress()
Dim Sh As Shape, ShX#, ShY#
Dim Cll As Range, CllX#, CllY#, Rws&, Col&
Dim I As Long, J As Long
Set Sh = ActiveSheet.Shapes(1)
ShX = Sh.Left + Sh.Width / 2
ShY = Sh.Top + Sh.Height / 2
Set Cll = Sh.TopLeftCell.Cells
CllX = Cll.Left: CllY = Cll.Top
Do While CllX <= ShX
    Col = Cll.Column
    I = I + 1
    Set Cll = Cll.Offset(, I)
    CllX = Cll.Left
Loop
Do While CllY <= ShY
    Rws = Cll.Row
    J = J + 1
    Set Cll = Cll.Offset(J)
    CllY = Cll.Top
Loop
MsgBox Cells(Rws, Col).Address
End Sub

Xem code

Sub CenterShapesAddress()
  Dim Sh As Shape, ShX#, ShY#, Cll As Range
  Set Sh = ActiveSheet.Shapes(1)
  ShX = Sh.Left + Sh.Width / 2
  ShY = Sh.Top + Sh.Height / 2
  Set Cll = Sh.TopLeftCell.Cells
  Do
    If Cll.Offset(, 1).Left < ShX Then Set Cll = Cll.Offset(, 1)
    If Cll.Offset(1).Top < ShY Then Set Cll = Cll.Offset(1)
  Loop Until Cll.Offset(, 1).Left >= ShX And Cll.Offset(1).Top >= ShY
  MsgBox Cll.Address
End Sub

 

[Nhattanktnn]

Xem code

Sub CenterShapesAddress()
  Dim Sh As Shape, ShX#, ShY#, Cll As Range
  Set Sh = ActiveSheet.Shapes(1)
  ShX = Sh.Left + Sh.Width / 2
  ShY = Sh.Top + Sh.Height / 2
  Set Cll = Sh.TopLeftCell.Cells
  Do
    If Cll.Offset(, 1).Left < ShX Then Set Cll = Cll.Offset(, 1)
    If Cll.Offset(1).Top < ShY Then Set Cll = Cll.Offset(1)
  Loop Until Cll.Offset(, 1).Left >= ShX And Cll.Offset(1).Top >= ShY
  MsgBox Cll.Address
End Sub

Cảm ơn bác Hiếu rất nhiều!