Double click vào cell sẽ hiển thị Hyperlink (1 người xem)

[humucxt]

Chào các bác! Nhờ các bác giúp em có đoạn code nào khi mình click vào cell thuộc cột được định trước sẽ hiện thị ra hộp chọn hyperlink đến file và chỉ hiện thị tên file ở cell hiện hành, tương tự như khi ta click trực tiếp vào hyperlink có sẵn trên excel.
Em cảm ơn nhiều

 

[ndu96081631]

Chào các bác! Nhờ các bác giúp em có đoạn code nào khi mình click vào cell thuộc cột được định trước sẽ hiện thị ra hộp chọn hyperlink đến file và chỉ hiện thị tên file ở cell hiện hành, tương tự như khi ta click trực tiếp vào hyperlink có sẵn trên excel.
Em cảm ơn nhiều

Không hình dung ra được bạn muốn gì cả?
Gửi file và kèm mô tả chi tiết đi

 

[Quang_Hải]

Chào các bác! Nhờ các bác giúp em có đoạn code nào khi mình click vào cell thuộc cột được định trước sẽ hiện thị ra hộp chọn hyperlink đến file và chỉ hiện thị tên file ở cell hiện hành, tương tự như khi ta click trực tiếp vào hyperlink có sẵn trên excel.
Em cảm ơn nhiều

Sub HP()
    ActiveSheet.Hyperlinks.Add ActiveCell, "Phai the nay khong?"
End Sub

 

[humucxt]

Không hình dung ra được bạn muốn gì cả?
Gửi file và kèm mô tả chi tiết đi

Các bác xem file mô tả của em nhá!
Cảm ơn các bác đã quan tâm và giúp đỡ

 

[ndu96081631]

Các bác xem file mô tả của em nhá!
Cảm ơn các bác đã quan tâm và giúp đỡ

Hiện tại trên sheet CV đang có code sự kiện BeforeDoubleClick tại cột F thế này:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim Rng1 As Range
  Set Rng1 = Range("F9:F100")
  If Intersect(Target, Rng1) Is Nothing Then Exit Sub
  Cancel = True
  Calendar.Show
End Sub

Vậy ta sửa lại code trên để thêm sự kiện BeforeDoubleClick cho vùng K9:L100 nữa là được:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim Rng1 As Range, rng2 As Range, vFile, fileName As String
  Set Rng1 = Range("F9:F100")
  Set rng2 = Sheet1.Range("K9:L100")
  If Not Intersect(Target, Rng1) Is Nothing Then
    Cancel = True
    Calendar.Show
  ElseIf Not Intersect(Target, rng2) Is Nothing Then
    Cancel = True
    vFile = Application.GetOpenFilename("All Files, *.*")
    If TypeName(vFile) = "String" Then
      fileName = CStr(vFile)
      fileName = Mid(fileName, InStrRev(fileName, "\") + 1)
      Target.Value = fileName
    End If
  End If
End Sub

Nếu code này đúng ý bạn thì đây chẳng phải Hyperlink gì cả mà chỉ là code mở hợp OpenFileName để lấy tên file thôi
--------------------
Lưu ý: Nếu code trên không chạy được trên file của bạn, vui lòng vào menu Tools\References và bỏ check các mục "MISSING... " nhé

 

[humucxt]

Cảm ơn bác rất nhiều. Cài này đúng theo ý của em rồi. CHỉ có điều tại Range(K9:L100) chỉ hiện thị tên file mà không phải dưới dạng hyperlink. Em muốn sau đó click vô tên file nó sẽ tự động mở ra file tương ứng.
Bác giúp em nha!

 

[ndu96081631]

Cảm ơn bác rất nhiều. Cài này đúng theo ý của em rồi. CHỉ có điều tại Range(K9:L100) chỉ hiện thị tên file mà không phải dưới dạng hyperlink. Em muốn sau đó click vô tên file nó sẽ tự động mở ra file tương ứng.
Bác giúp em nha!

Sửa thành vầy:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim Rng1 As Range, rng2 As Range, vFile, fileName As String
  Set Rng1 = Range("F9:F100")
  Set rng2 = Sheet1.Range("K9:L100")
  If Not Intersect(Target, Rng1) Is Nothing Then
    Cancel = True
    Calendar.Show
  ElseIf Not Intersect(Target, rng2) Is Nothing Then
    Cancel = True
    vFile = Application.GetOpenFilename("All Files, *.*")
    If TypeName(vFile) = "String" Then
      fileName = CStr(vFile)
      fileName = Mid(fileName, InStrRev(fileName, "\") + 1)
      Target.Value = fileName
      [COLOR=#ff0000]Target.Hyperlinks.Add Target, CStr(vFile), , , fileName[/COLOR]
    End If
  End If
End Sub

Chỗ màu đỏ là vừa mới thêm vào.
Thật ra đoạn code màu đỏ ở trên bạn vẫn có thể tự mình nghiên cứu bằng cách record macro quá trình tạo Hyperlink bằng tay xem code viết gì là có thể suy luận rồi
(cái gì cũng hỏi sẽ làm mất khả năng tư duy)

 

[humucxt]

Sửa thành vầy:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim Rng1 As Range, rng2 As Range, vFile, fileName As String
  Set Rng1 = Range("F9:F100")
  Set rng2 = Sheet1.Range("K9:L100")
  If Not Intersect(Target, Rng1) Is Nothing Then
    Cancel = True
    Calendar.Show
  ElseIf Not Intersect(Target, rng2) Is Nothing Then
    Cancel = True
    vFile = Application.GetOpenFilename("All Files, *.*")
    If TypeName(vFile) = "String" Then
      fileName = CStr(vFile)
      fileName = Mid(fileName, InStrRev(fileName, "\") + 1)
      Target.Value = fileName
      [COLOR=#ff0000]Target.Hyperlinks.Add Target, CStr(vFile), , , fileName[/COLOR]
    End If
  End If
End Sub

Chỗ màu đỏ là vừa mới thêm vào.
Thật ra đoạn code màu đỏ ở trên bạn vẫn có thể tự mình nghiên cứu bằng cách record macro quá trình tạo Hyperlink bằng tay xem code viết gì là có thể suy luận rồi
(cái gì cũng hỏi sẽ làm mất khả năng tư duy)

Cảm ơn tiền bối nhiều.
Em cũng tự nghiên cứu mà ko ra. Khả năng chưa tới cộng với kiến thức về VBA còn hạn chế nên ko biết mày mò thế nào.
Đúng là tiền bối kiến thức rộng lớn, cái gì cũng giúp được. Một lần nữa cảm ơn thầy và chúc thầy sức khỏe