Cần giúp đỡ lấy dia chi insert trong hinh (1 người xem)

[vantrangst]

Mình có 1 loạt hình liên kết đến 1 website, mình muốn lấy hyperlink được insert trong hình để dán sang cột kế bên. Nếu click vào từng hình thì rất nhiều và lâu.
Bạn nào có thể có cách để lấy link nhanh cho thì hướng dẫn cho mình nha.
Cám ơn nhiều.
File ví dụ cho bạn hiểu ý

 

[dhn46]

Bạn sử dụng Code sau

Sub ShpHyperlink()
    On Error Resume Next
    Application.ScreenUpdating = False
    Dim Shp As Shape
    For Each Shp In ActiveSheet.Shapes
        Shp.TopLeftCell.Offset(, 1) = Shp.Hyperlink.Address
    Next
    Application.ScreenUpdating = False
End Sub

 

[vantrangst]

Bạn sử dụng Code sau

Sub ShpHyperlink()
    On Error Resume Next
    Application.ScreenUpdating = False
    Dim Shp As Shape
    For Each Shp In ActiveSheet.Shapes
        Shp.TopLeftCell.Offset(, 1) = Shp.Hyperlink.Address
    Next
    Application.ScreenUpdating = False
End Sub

Cám ơn bạn rất nhiều nhiều. Đúng là cái mình đang cần.

 

[vantrangst]

Bạn chỉ cho mình chỗ này nữa nha. Nếu có 3 hình như trong ví dụ mình gửi, mà mình chỉ muốn lấy link ở hình con mắt thôi, mình áp dụng code bạn cho thì nó chỉ lấy link hình thùng rác, mình có sửa lại Shp.BottomRightCell.Offset nhưng nó vẫn lấy link cái hình bên phải thôi, bạn chỉ cho mình cách lấy link của hình con mắt ở trái nha.

Cám ơn rất nhiều.

 

[dhn46]

Bạn chỉ cho mình chỗ này nữa nha. Nếu có 3 hình như trong ví dụ mình gửi, mà mình chỉ muốn lấy link ở hình con mắt thôi, mình áp dụng code bạn cho thì nó chỉ lấy link hình thùng rác, mình có sửa lại Shp.BottomRightCell.Offset nhưng nó vẫn lấy link cái hình bên phải thôi, bạn chỉ cho mình cách lấy link của hình con mắt ở trái nha.

Cám ơn rất nhiều.

Với dữ liệu của bạn thì bạn thử với sub sau

Sub ShpHyperlink()
    On Error Resume Next
    Application.ScreenUpdating = False
    Dim Shp As Shape
    Dim i As Long, Dimention As Long
    For Each Shp In ActiveSheet.Shapes
        If Shp.Left = Shp.TopLeftCell.Left Then
            Shp.TopLeftCell.Offset(, 1) = Shp.Hyperlink.Address
        End If
    Next
    Application.ScreenUpdating = False
End Sub

 

[sealand]

Mình thấy tốt nhất là phải dựa vào tên của nó mới chính xác được. Trong file này lại đánh số tên ngược từ lớn về nhỏ. Mình viết code lấy link cũng phải ngược 1 chút
Thực tế thì nên đặt tên:
-Mat 001, Mat 002....
-Thu 001 ,Thu 002....
-Rac 001, Rac 002 ....

Khi cần dùng thằng nào thì cứ tên nó với thứ tự mà gọi

Bạn tham khảo 1 cách khác của mình nha

Sub AdLink()
Dim i, Dg
i = 1
Dg = Sheet1.Shapes.Count / 3 + 1
On Error GoTo Thoat
Do
Sheet1.Cells(Dg - i, 3) = Sheet1.Shapes("Picture " & (i * 3 - 2)).Hyperlink.Address
i = i + 1
Loop
Thoat:
End Sub

 

[vantrangst]

Cám ơn mọi người đã giúp đỡ, chỉ dạy.
Với cách của bạn dhn46 mình đã làm được rồi, còn cách của bạn sealand mình áp dụng thì báo lỗi. Mình chỉ cần 1 lấy cách làm là được rồi. Cám ơn rất nhiều