Liên kết tự động nhiều Shape với nhiều cell theo quy luât. (1 người xem)

[chuot0106]

Tôi có 4 Shape từ shape1 đến shape4(có thể nhiều hơn)
Tôi muốn thực hiện Hyperlink 4 shape này với các cell theo quy luật như sau:
shape1 liên kết với ô A1
shape2 liên kết với ô A6
shape3 liên kết với ô A11
shape4 liên kết với ô A16
Tức các ô này cùng 1 cột và cách nhau 5 dòng.
Cách Hyperlink bẳng tay thì tôi biết làm rồi.
Tôi có viết code để thực hiện liên kết tự động các shape này với các ô có quy luật đó như sau nhưng không biết sai ở đâu mà code không chạy. Nhờ các anh chị và các bạn xem, chỉ ra lỗi, bổ sung, sửa…để code có thể chạy. Cảm ơn!

Public Sub Hypperlinks()
Dim i As Long, a As Long, b As Long
a = ActiveSheet.Shapes.Count
b = 1
For i = 1 To a
ActiveSheet.Shapes(i).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(i), Address:= _
"", SubAddress:="Sheet1!A" & b
b = b + 5
Next i
End Sub

 

[ndu96081631]

Tôi có 4 Shape từ shape1 đến shape4(có thể nhiều hơn)
Tôi muốn thực hiện Hyperlink 4 shape này với các cell theo quy luật như sau:
shape1 liên kết với ô A1
shape2 liên kết với ô A6
shape3 liên kết với ô A11
shape4 liên kết với ô A16
Tức các ô này cùng 1 cột và cách nhau 5 dòng.
Cách Hyperlink bẳng tay thì tôi biết làm rồi.
Tôi có viết code để thực hiện liên kết tự động các shape này với các ô có quy luật đó như sau nhưng không biết sai ở đâu mà code không chạy. Nhờ các anh chị và các bạn xem, chỉ ra lỗi, bổ sung, sửa…để code có thể chạy. Cảm ơn!

Viết vầy:

Public Sub Hypperlinks()
  Dim i As Long, a As Long, b As Long
  [COLOR=#ff0000]With ActiveSheet[/COLOR]
    a = .Shapes.Count
    b = 1
    For i = 1 To a
      [COLOR=#ff0000]If .Shapes(i).Name <> Application.Caller Then[/COLOR]
        .Hyperlinks.Add .Shapes(i), "", [COLOR=#ff0000]"'" & .Name & "'!A" & b[/COLOR]
        b = b + 5
      End If
    Next i
  [COLOR=#ff0000]End With[/COLOR]
End Sub

 

[phucbugis]

Tôi có 4 Shape từ shape1 đến shape4(có thể nhiều hơn)
Tôi muốn thực hiện Hyperlink 4 shape này với các cell theo quy luật như sau:
shape1 liên kết với ô A1
shape2 liên kết với ô A6
shape3 liên kết với ô A11
shape4 liên kết với ô A16
Tức các ô này cùng 1 cột và cách nhau 5 dòng.
Cách Hyperlink bẳng tay thì tôi biết làm rồi.
Tôi có viết code để thực hiện liên kết tự động các shape này với các ô có quy luật đó như sau nhưng không biết sai ở đâu mà code không chạy. Nhờ các anh chị và các bạn xem, chỉ ra lỗi, bổ sung, sửa…để code có thể chạy. Cảm ơn!

thử tiếp cái này:
[GPECODE=vb]
Sub Add_Hyperlink()
Dim ws As Worksheet
Dim rng As Range
Dim vung As Range
Dim CellRef As String

Set ws = ThisWorkbook.Sheets("Sheet1")
Set vung = ws.Range("I7:I100")

For Each rng In vung
CellRef = rng.Offset(, 1).Value
If rng <> "" And CellRef <> "" Then
ws.Hyperlinks.Add ws.Shapes(rng.Value), _
Address:="", _
SubAddress:="'" & ws.Name & "'!" & CellRef, _
ScreenTip:="go to " & CellRef
End If
Next

Set ws = Nothing: Set vung = Nothing
End Sub

[/GPECODE]

 

[chuot0106]

Viết vầy:

Public Sub Hypperlinks()
  Dim i As Long, a As Long, b As Long
  [COLOR=#ff0000]With ActiveSheet[/COLOR]
    a = .Shapes.Count
    b = 1
    For i = 1 To a
      [COLOR=#ff0000]If .Shapes(i).Name <> Application.Caller Then[/COLOR]
        .Hyperlinks.Add .Shapes(i), "", [COLOR=#ff0000]"'" & .Name & "'!A" & b[/COLOR]
        b = b + 5
      End If
    Next i
  [COLOR=#ff0000]End With[/COLOR]
End Sub

Thầy ơi, em chạy thử code thầy viết thì nó báo lỗi như hình sau:



P/S: Không hiểu sao khi chạy code trực tiếp từ cửa sổ VBA thì không được(báo lỗi như hình), nhưng khi gán macro vào nút lệnh thì lại chạy rất ngon không báo lỗi gì thầy ạ!

 

[ndu96081631]

Thầy ơi, em chạy thử code thầy viết thì nó báo lỗi như hình sau:



P/S: Không hiểu sao khi chạy code trực tiếp từ cửa sổ VBA thì không được(báo lỗi như hình), nhưng khi gán macro vào nút lệnh thì lại chạy rất ngon không báo lỗi gì thầy ạ!

Đương nhiên là không thể chạy từ cửa sổ VBA rồi, vì trong code có dùng đến Application.Caller
Trên sheet của bạn, ngoài các hình vẽ thì còn có 1 button và nó cũng được xem là Shape. Vậy nên khi bạn chạy code, nếu chỉ nói Shapes(i) chung chung thì nó sẽ tính luôn thằng button kia ---> Dẫn đến sai bét
Cái thằng Application.Caller là ý muốn nói đến button ấy và câu lệnh If .Shapes(i).Name <> Application.Caller Then là dùng để loại thằng Button ra khỏi danh sách các shape mà ta cần duyệt trong vòng lập
Vậy:
- Nếu bạn nhấn nút: Application.Caller chính là button
- Nếu bạn chạy code từ cửa sổ VBA: Application.Caller.. hổng là cái gì cả ---> Code báo lỗi

 

[chuot0106]

Viết vầy:

Public Sub Hypperlinks()
  Dim i As Long, a As Long, b As Long
  [COLOR=#ff0000]With ActiveSheet[/COLOR]
    a = .Shapes.Count
    b = 1
    For i = 1 To a
      [COLOR=#ff0000]If .Shapes(i).Name <> Application.Caller Then[/COLOR]
        .Hyperlinks.Add .Shapes(i), "", [COLOR=#ff0000]"'" & .Name & "'!A" & b[/COLOR]
        b = b + 5
      End If
    Next i
  [COLOR=#ff0000]End With[/COLOR]
End Sub

Mong thầy cho biết code của em bị lỗi ở đâu ạ?
Em thử thêm dòng lệnh bẫy lỗi:
On error resume next thì code lại chạy rất mượt.

Public Sub Hypperlinks()
Dim i As Long, a As Long, b As Long
On Error Resume Next
a = ActiveSheet.Shapes.Count
b = 1
For i = 1 To a
ActiveSheet.Shapes(i).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:= _
"", SubAddress:="Sheet1!A" & b
b = b + 5
Next i
End Sub

Thực ra em viết code này dựa vào ghi macro nên em không hiểu ý nghĩa của nó lắm!
Nếu có thể mong thầy giải thích cho em ý nghĩa của câu lệnh(màu đỏ) trong code của thầy với ạ!

Public Sub Hypperlinks()
Dim i As Long, a As Long, b As Long
With ActiveSheet
a = .Shapes.Count
b = 1
For i = 1 To a
If .Shapes(i).Name <> Application.Caller Then
.Hyperlinks.Add .Shapes(i), "", "'" & .Name & "'!A" & b
b = b + 5
End If
Next i
End With
End Sub

 

[ndu96081631]

Mong thầy cho biết code của em bị lỗi ở đâu ạ?
Em thử thêm dòng lệnh bẫy lỗi:
On error resume next thì code lại chạy rất mượt.

Thực ra em viết code này dựa vào ghi macro nên em không hiểu ý nghĩa của nó lắm!
Nếu có thể mong thầy giải thích cho em ý nghĩa của câu lệnh(màu đỏ) trong code của thầy với ạ!

Như đã nói ở trên, code của bạn sẽ add Hyperlink cho toàn bộ shapes, bao gồm luôn cái button mà bạn nhấn đế chạy code
Vậy bây giờ bạn thử tạo Hyperlink bằng tay cho button ấy xem có được không? Nếu làm bằng tay không được thì code đương nhiên phải lỗi rồi
Chính thế mà tôi mới có dòng code loại bỏ thằng button ấy ra khỏi danh sách, chính là dòng màu đỏ mà bạn vừa nhắc đến (đã giải thích ở bài 5 rồi còn gì)
Còn như bạn On Error Resume Next thì gặp lỗi nó cho qua luôn và ta cũng không bao giờ hiểu được đó là lỗi gì, từ đâu sinh ra cả

 

[chuot0106]

Như đã nói ở trên, code của bạn sẽ add Hyperlink cho toàn bộ shapes, bao gồm luôn cái button mà bạn nhấn đế chạy code
Vậy bây giờ bạn thử tạo Hyperlink bằng tay cho button ấy xem có được không? Nếu làm bằng tay không được thì code đương nhiên phải lỗi rồi
Chính thế mà tôi mới có dòng code loại bỏ thằng button ấy ra khỏi danh sách, chính là dòng màu đỏ mà bạn vừa nhắc đến (đã giải thích ở bài 5 rồi còn gì)
Còn như bạn On Error Resume Next thì gặp lỗi nó cho qua luôn và ta cũng không bao giờ hiểu được đó là lỗi gì, từ đâu sinh ra cả

Vâng ạ, em gửi bài xong thì mới nhận được câu trả lời ở #5 ạ:
Em muốn thầy giải thích cho em hiểu rõ hơn ý nghĩa của câu lệnh này ạmàu đỏ)
If .Shapes(i).Name <> Application.Caller Then
.Hyperlinks.Add .Shapes(i), "", "'" & .Name & "'!A" & b
Vì em đối chiếu với phần ghi Macro thấy nó khác nhau. Với lại câu lệnh trong phần ghi Macro em cũng chưa hiểu ý nghĩa của nó là gì. Mong thầy giải thích dùm em vơi!
Em đang tập tành về VBA mong thầy bỏ qua!

 

[ndu96081631]

Vâng ạ, em gửi bài xong thì mới nhận được câu trả lời ở #5 ạ:
Em muốn thầy giải thích cho em hiểu rõ hơn ý nghĩa của câu lệnh này ạmàu đỏ)
If .Shapes(i).Name <> Application.Caller Then
.Hyperlinks.Add .Shapes(i), "", "'" & .Name & "'!A" & b
Vì em đối chiếu với phần ghi Macro thấy nó khác nhau. Với lại câu lệnh trong phần ghi Macro em cũng chưa hiểu ý nghĩa của nó là gì. Mong thầy giải thích dùm em vơi!
Em đang tập tành về VBA mong thầy bỏ qua!

Nói gọn thế này (chứ nói cho rõ ra chắc mất 1 ngày):
Sau khi ta record macro xong, ta nhận được code với những dòng Select rồi Selection tùm lum cả lên. Việc của ta bây giờ là rút gọn code, bỏ mấy cái select, selection đi thôi mà
Ví dụ: Bạn record macro quá trình copy vùng A1:B10 và paste vào E1, bạn sẽ nhận được code sau:

Sub Macro1()

    Range("A1:B10")[COLOR=#ff0000].Select[/COLOR]
    [COLOR=#ff0000]Selection[/COLOR].Copy
    Range("E1").[COLOR=#ff0000]Select[/COLOR]
    ActiveSheet.Paste
End Sub

Giờ ta bỏ mấy cái Select, Selection đi, ta được:

Sub Macro1()
    Range("A1:B10").Copy  ''<--- Muốn copy cứ copy, cần gì Select
    Range("E1").PasteSpecial  ''<--- Muốn paste cứ paste, cần gì Select
End Sub

-------------------
Riêng trong các phương thức, chẳng hạn là phương thức Add trong Hyperlinks:

ActiveSheet.Hyperlinks.Add [COLOR=#ff0000]Anchor:=[/COLOR]Selection.ShapeRange.Item(1), [COLOR=#ff0000]Address:=[/COLOR]"", [COLOR=#ff0000]SubAddress:=[/COLOR]"Sheet1!A" & b

Thì mấy cái tên màu đỏ ở trên bạn có thể bỏ đi cũng không có vấn đề gì
(vấn đề này bạn phải tìm hiểu thêm mới được vì còn nói thì còn... dài nhiều tập nữa)

 

[chuot0106]

Nói gọn thế này (chứ nói cho rõ ra chắc mất 1 ngày):
Sau khi ta record macro xong, ta nhận được code với những dòng Select rồi Selection tùm lum cả lên. Việc của ta bây giờ là rút gọn code, bỏ mấy cái select, selection đi thôi mà
Ví dụ: Bạn record macro quá trình copy vùng A1:B10 và paste vào E1, bạn sẽ nhận được code sau:

Sub Macro1()

    Range("A1:B10")[COLOR=#ff0000].Select[/COLOR]
    [COLOR=#ff0000]Selection[/COLOR].Copy
    Range("E1").[COLOR=#ff0000]Select[/COLOR]
    ActiveSheet.Paste
End Sub

Giờ ta bỏ mấy cái Select, Selection đi, ta được:

Sub Macro1()
    Range("A1:B10").Copy  ''<--- Muốn copy cứ copy, cần gì Select
    Range("E1").PasteSpecial  ''<--- Muốn paste cứ paste, cần gì Select
End Sub

-------------------
Riêng trong các phương thức, chẳng hạn là phương thức Add trong Hyperlinks:

ActiveSheet.Hyperlinks.Add [COLOR=#ff0000]Anchor:=[/COLOR]Selection.ShapeRange.Item(1), [COLOR=#ff0000]Address:=[/COLOR]"", [COLOR=#ff0000]SubAddress:=[/COLOR]"Sheet1!A" & b

Thì mấy cái tên màu đỏ ở trên bạn có thể bỏ đi cũng không có vấn đề gì
(vấn đề này bạn phải tìm hiểu thêm mới được vì còn nói thì còn... dài nhiều tập nữa)

Vâng, em cũng hiểu được phần nào rồi ạ, chắc em phải tự tìm hiểu thêm nữa thì mới nắm sâu hơn được. Cảm ơn thầy rất nhiều ạ!