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 đỡ

 

[ptm0412]

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 đỡ

Theo ý tưởng lặp thì cũng chỉ lặp đến khi thoả thì ngưng chứ đâu có lặp hết sheet

 

[Nhattanktnn]

Theo ý tưởng lặp thì cũng chỉ lặp đến khi thoả thì ngưng chứ đâu có lặp hết sheet

Vâng đúng rồi thầy, nãy em nói quên nghĩ. Hướng lặp từ vị trí tâm lên trên, rồi từ tâm sang trái, gặp thỏa thì dừng. Nhưng em vẫn chưa nghĩ được cách làm ạ

 

[befaint]

Vẽ cái hình ra là dễ thấy luôn mà.

0/ Xác định Cell chứa TOP của shape: cellTop
1/ Xác định tọa độ tâm shape: (x, y)
2/ Xác định cột chứa tâm shape: Dò từ cellTop, tới khi nào leftCell <= x <= rightCell thì dừng lại.
3/ Xác định dòng chứa tâm shape: Làm tương tự (2).

 

[ptm0412]

Vẽ cái hình ra là dễ thấy luôn mà.

0/ Xác định Cell chứa TOP của shape: cellTop
1/ Xác định tọa độ tâm shape: (x, y)
2/ Xác định cột chứa tâm shape: Dò từ cellTop, tới khi nào leftCell <= x <= rightCell thì dừng lại.
3/ Xác định dòng chứa tâm shape: Làm tương tự (2).

Có lẽ vội nên nhầm lẫn top left, lại còn right nữa chứ
Thêm: mục (0): xác định cell chứa top được thì xác định cell chứa tâm luôn cho khoẻ, theo hình thì top của shape cũng đang nằm lơ lửng y như cái tâm

Vâng đúng rồi thầy, nãy em nói quên nghĩ. Hướng lặp từ vị trí tâm lên trên, rồi từ tâm sang trái, gặp thỏa thì dừng. Nhưng em vẫn chưa nghĩ được cách làm ạ

Từ trái đến tâm và từ trên xuống tâm chứ (làm ngược sao ra)

 

[befaint]

Có lẽ vội nên nhầm lẫn top left, lại còn right nữa chứ

Ớ. Em vẫn chưa biết nhầm chỗ nào?

 

[ptm0412]

Ớ. Em vẫn chưa biết nhầm chỗ nào?

0: xác định cell chứa top (giả sử xác định được, xem mục "thêm" của bài 5)
1; không bàn
2. có top thì dò y chứ sao dò x. Ngoài ra "leftCell <= x <= rightCell" phải nói rõ là top của leftCell <= x <= top của rightCell (dù đang ngược x/ y)

 

[Nhattanktnn]

Thêm: mục (0): xác định cell chứa top được thì xác định cell chứa tâm luôn cho khoẻ, theo hình thì top của shape cũng đang nằm lơ lửng y như cái tâm

Em cũng đang nghĩ như vậy, dựa vào topleft của shapes thì không biết được nó đang thuộc ô nào, còn nếu có cách tính topleft thuộc ô nào thì tính trực tiếp cái tâm luôn

 

[befaint]

2. có top thì dò y chứ sao dò x.

Em nêu là cellTop mà, không phải Top.

Ngoài ra "leftCell <= x <= rightCell" phải nói rõ là top của leftCell <= x <= top của rightCell (dù đang ngược x/ y)

Cell có Left mà anh.
và rightCell = leftCell + widthCell

 

[Ngô Hải Đăng]

Nếu bạn muốn kéo hình từ ô này qua ô khác rồi căn hình cho vừa với ô đó thì dùng TopLeft sẽ trực quan hơn chứ. Ví dụ bạn kéo hình từ A1 đến A10 thì chỉ cần TopLeft của hình nằm trong ô A10 thì hình sẽ căn vừa ô A10. Nếu sử dụng tâm hình thì làm sao bạn nhìn được tâm hình nó đúng ô A10 chưa.

 

[Nhattanktnn]

Nếu bạn muốn kéo hình từ ô này qua ô khác rồi căn hình cho vừa với ô đó thì dùng TopLeft sẽ trực quan hơn chứ. Ví dụ bạn kéo hình từ A1 đến A10 thì chỉ cần TopLeft của hình nằm trong ô A10 thì hình sẽ căn vừa ô A10. Nếu sử dụng tâm hình thì làm sao bạn nhìn được tâm hình nó đúng ô A10 chưa.

Tại vì hình ảnh thường được chèn vào không chính xác ô, nếu theo topleft thì như hình dưới sẽ là ô C1, đúng phải là D2


Mình đang làm theo hướng anh @befaint nói, và có lẽ sắp có kết quả

 

[Ngô Hải Đăng]

Tại vì hình ảnh thường được chèn vào không chính xác ô, nếu theo topleft thì như hình dưới sẽ là ô C1, đúng phải là D2
View attachment 261730

Mình đang làm theo hướng anh @befaint nói, và có lẽ sắp có kết quả

Là do ban đầu người chèn hình sai vị trí. Bạn có thể thử cách chỉnh lại như sau: Top Hình = Top Hình + Height Hình/2 và Left Hình = Left Hình + Width Hình/2. Sau đó thì đưa về bài toán chỉnh hình theo TopLeft thôi.

 

[ptm0412]

Mình đang làm theo hướng anh @befaint nói, và có lẽ sắp có kết quả

Làm theo lão chết tiệt ra kết quả luôn nè

Sub FindCeltralCell()
Dim xPos As Double, yPos As Double
Dim xCel As Double, yCel As Double
Dim xCel2 As Double, yCel2 As Double
Dim Rw As Long, Col As Long
With ActiveSheet.Shapes(1)
    xPos = (.Left * 2 + .Width) / 2
    yPos = (.Top * 2 + .Height) / 2
End With
    For x = 1 To 100
        yCel = Cells(1, x).Left
        yCel2 = Cells(1, x + 1).Left
        If xPos >= yCel And xPos <= yCel2 Then
            Col = x
            Exit For
        End If
    Next
    For y = 1 To 100
        xCel = Cells(y, 1).Top
        xCel2 = Cells(y + 1, 1).Top
        If yPos >= xCel And yPos <= xCel2 Then
            Rw = y
            Exit For
        End If
    Next
    MsgBox Cells(Rw, Col).Address
End Sub

 

[huuthang_bd]

Giảm 1/2 kích thước hình ảnh (rộng giảm 1/2, cao giảm 1/2), BottomRightCell là ô cần tìm. Hoặc add 1 shape tạm tại tâm rồi lấy TopLeftCell của shape đó.

Function CenterCll1(ByRef oShape As Object)
Dim dW As Double, dH As Double
With oShape
    dW = .Width:  dH = .Height
    .Width = dW / 2:   .Height = dH / 2
    Set CenterCll1 = .BottomRightCell
    .Width = dW:       .Height = dH
End With
End Function
'''''''''''''''''''''''''''''''''''''''''''
Function CenterCll2(ByRef oShape As Object)
Dim x As Double, y As Double
x = oShape.Left + oShape.Width / 2
y = oShape.Top + oShape.Height / 2
With Sheet1.Shapes.AddLine(x, y, x, y)
    Set CenterCll2 = .TopLeftCell
    .Delete
End With
End Function
'''''''''''''''''''''''''''''''''''''''''''
Sub Test()
Dim oShape As Object
Set oShape = Sheets(1).Shapes(1)
MsgBox CenterCll1(oShape).Address
MsgBox CenterCll2(oShape).Address
End Sub

 

[ptm0412]

xác định tâm của shape theo tọa độ (left+width/2, top+height/2)

Phải là (2 * left + width)/ 2 và (2 * top + height)/ 2 mới đúng

 

[Nhattanktnn]

Phải là (2 * left + width)/ 2 và (2 * top + height)/ 2 mới đúng

(2 * left + width)/ 2 = left+width/2 mà thầy

 

[ptm0412]

(2 * left + width)/ 2 = left+width/2 mà thầy

Ờ, tôi nhầm, cứ tưởng có dấu ngoặc trước khi chia 2

 

[Nhattanktnn]

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

 

[Ngô Hải Đăng]

ShX = Sh.Left + Sh.Width / 2 ShY = Sh.Top + Sh.Height / 2 Set Cll = Sh.TopLeftCell.Cells

thử thay bằng
Sh.Left = Sh.Left + Sh.Width / 2
Sh.Top = Sh.Top + Sh.Height / 2
Debug.Print Sh.TopLeftCell.Address

Bỏ hết vòng lặp bên dưới.

 

[Nhattanktnn]

thử thay bằng
Sh.Left = Sh.Left + Sh.Width / 2
Sh.Top = Sh.Top + Sh.Height / 2
Debug.Print Sh.TopLeftCell.Address

Bỏ hết vòng lặp bên dưới.

Cảm ơn bạn, mình cũng đã từng code theo kiểu di chuyển shapes vậy rồi, cái bài trên là mình làm theo hướng tính toán ra địa chỉ mà không di chuyển shape. Tất nhiên mục đích cuối cùng thì cũng là như code bạn nêu ra. Cảm ơn bạn, các thầy và các anh chị đã giúp đỡ!