Nhờ sửa code get hyperlink

[xkun2001]

Chào các bạn,
Các bạn sửa giúp mình lỗi đoạn mã sau với:

Lỗi là không lấy đúng tên filename:

Sub GetHyperlink()
  Dim i, St, pathF, Fname
  On Error Resume Next
  With Application.FileDialog(3)
    .AllowMultiSelect = False
    .Title = "Hay lua chon file"
    .ButtonName = "Chon"
    pathF = .InitialFileName
    If .Show <> -1 Then GoTo NextCode
    St = .SelectedItems(1)
  End With

  If St <> "" Then
    Fname = Right(St, Len(St) - Len(pathF))
    i = Len(Fname)
    Do    'Bo file type
      i = i - 1
      If Mid(Fname, i, 1) = "." Then
        Fname = Left(Fname, i - 1)
        Exit Do
      End If
    Loop Until i = 0

    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=St, TextToDisplay:=Fname
 End Sub

 

[Hoàng Trọng Nghĩa]

Chào các bạn,
Các bạn sửa giúp mình lỗi đoạn mã sau với:

Lỗi là không lấy đúng tên filename:

Sub GetHyperlink()
  Dim i, St, pathF, Fname
  On Error Resume Next
  With Application.FileDialog(3)
    .AllowMultiSelect = False
    .Title = "Hay lua chon file"
    .ButtonName = "Chon"
    pathF = .InitialFileName
    If .Show <> -1 Then GoTo NextCode
    St = .SelectedItems(1)
  End With

  If St <> "" Then
    Fname = Right(St, Len(St) - Len(pathF))
    i = Len(Fname)
    Do    'Bo file type
      i = i - 1
      If Mid(Fname, i, 1) = "." Then
        Fname = Left(Fname, i - 1)
        Exit Do
      End If
    Loop Until i = 0

    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=St, TextToDisplay:=Fname
 End Sub

Dường như code của bạn chép còn thiếu:
1) Có IF mà không có END IF ( If St <> "" Then)
2) Có GoTo NextCode nhưng không có nhãn NextCode nằm ở đâu.

Tôi nghĩ sửa đại thế này, bạn xem dùng được không:

Sub GetHyperlink()
    Dim i, St, pathF, Fname
    On Error Resume Next
    With Application.FileDialog(3)
        .AllowMultiSelect = False
        .Title = "Hay lua chon file"
        .ButtonName = "Chon"
        pathF = .InitialFileName
        If .Show <> -1 Then GoTo NextCode
        St = .SelectedItems(1)
    End With
    If St <> "" Then
        Fname = Right(St, Len(St) - Len(pathF))
        i = Len(Fname)
        Do    'Bo file type
            i = i - 1
            If Mid(Fname, i, 1) = "." Then
                Fname = Left(Fname, i - 1)
                Exit Do
            End If
        Loop Until i = 0
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=St, TextToDisplay:=Fname
    End If
NextCode:
End Sub

 

[xkun2001]

Dường như code của bạn chép còn thiếu:
1) Có IF mà không có END IF ( If St <> "" Then)
2) Có GoTo NextCode nhưng không có nhãn NextCode nằm ở đâu.

Tôi nghĩ sửa đại thế này, bạn xem dùng được không:

Sub GetHyperlink()
    Dim i, St, pathF, Fname
    On Error Resume Next
    With Application.FileDialog(3)
        .AllowMultiSelect = False
        .Title = "Hay lua chon file"
        .ButtonName = "Chon"
        pathF = .InitialFileName
        If .Show <> -1 Then GoTo NextCode
        St = .SelectedItems(1)
    End With
    If St <> "" Then
        Fname = Right(St, Len(St) - Len(pathF))
        i = Len(Fname)
        Do    'Bo file type
            i = i - 1
            If Mid(Fname, i, 1) = "." Then
                Fname = Left(Fname, i - 1)
                Exit Do
            End If
        Loop Until i = 0
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=St, TextToDisplay:=Fname
    End If
NextCode:
End Sub

Sub khá dài nên mình cắt bớt, chỉ để phần cần hỏi nên câu lệnh ko hoàn chỉnh. Cám ơn bạn góp ý!

 

[Hoàng Trọng Nghĩa]

Sub khá dài nên mình cắt bớt, chỉ để phần cần hỏi nên câu lệnh ko hoàn chỉnh. Cám ơn bạn góp ý!

Bạn nhờ sửa code mà chơi "cắt bớt", đáng nể bạn thật!!!

 

[xkun2001]

Bạn nhờ sửa code mà chơi "cắt bớt", đáng nể bạn thật!!!

mình cắt bớt các modun ko liên quan thôi bạn. Mình nhờ mọi ng sửa code để lấy đúng tên file, vì code của mình tên file ko đúng bạn ạ.

 

[xkun2001]

Cám ơn các bạn đã nhắn tin trợ giúp. Mình đã sửa được rồi:

Sub GetHyperlink()
  Dim i, n, St, pathF, Fname
  On Error Resume Next
  With Application.FileDialog(3)
    .AllowMultiSelect = False
    .Title = "Hay lua chon file"
    .ButtonName = "Chon 1 file"
    If .Show <> -1 Then GoTo NextCode
    St = .SelectedItems(1)
  End With
  If St <> "" Then
    'Loc lay ten file:
    n = Len(St)
    i = n
    Do
        i = i - 1
        If Mid(St, i, 1) = "\" Then
            Fname = Right(St, n - i)
            Exit Do
        End If
    Loop Until i = 0
    
    'Bo file type:
    i = Len(Fname)
    Do
      i = i - 1
      If Mid(Fname, i, 1) = "." Then
        Fname = Left(Fname, i - 1)
        Exit Do
      End If
    Loop Until i = 0
    
    If Len(Fname) > 25 Then Fname = Left(Fname, 25) & " ..."
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=St, TextToDisplay:=Fname
    Selection.Style = "KStyle 1"
  End If
 
NextCode:
End Sub