Tạo mục lục trong excel

[phamhoan]

Em mới tham gia 4rum nên ko biết post ở đâu cho đúng, nếu sai box nhờ mod move hộ em ah, thank
Các bác cho em hỏi ban đầu mình có danh sách các file word,giờ làm sao để tạo được 1 cái list như trong hình 1 ạ,để khi click vào mục lục thì nó tự mở file word đó lên ạ

thank các bác

 

[Hai Lúa Miền Tây]

Bạn chạy code sau nhé:

Sub LietKeFileDoc()
    Dim stDir, stFile As String
    Dim R As Range
    
    Set R = ActiveCell
    
    With Application.FileDialog(msoFileDialogFolderPicker)
          .AllowMultiSelect = False
       If .Show = -1 Then
          
          stDir = .SelectedItems(1)
          
       End If
    End With
    stFile = Dir(stDir & "\*.doc")
    
    Do Until stFile = ""
        R.Hyperlinks.Add R, stDir & "\" & stFile, , , stFile
        Set R = R.Offset(1)
        stFile = Dir()
    Loop
    
    R.CurrentRegion.Sort key1:=R, order1:=xlAscending, header:=xlNo
    
End Sub

 

[boyxin]

Em mới tham gia 4rum nên ko biết post ở đâu cho đúng, nếu sai box nhờ mod move hộ em ah, thank
Các bác cho em hỏi ban đầu mình có danh sách các file word,giờ làm sao để tạo được 1 cái list như trong hình 1 ạ,để khi click vào mục lục thì nó tự mở file word đó lên ạ

thank các bác

Theo yêu cầu của bạn, tên file là VB.... nhưng tên VB lại lại lấy ở đâu đó thì theo mình nghĩ là hơi khó (tạm thời chưa nghĩ ra)

Lấy tên các file trong thư mục hiện hành: để file này vào thư mục cần lấy List & Link

Tập tin đính kèm

• 
  Tao list va link.rar

Code trong file (boyxin kiếm trên GPE - không nhớ của ai và sửa tý xíu):

Option Explicit
Public Sub Get_Files()
Dim i As Double, sFil As String
Application.ScreenUpdating = False
[a1].CurrentRegion.ClearContents
sFil = Dir(ThisWorkbook.path & "\*.*")
Cells(1, 1) = "TT": Cells(1, 2) = "File in " & ThisWorkbook.path
With Range("A1:B1")
    .Font.Bold = True: .Font.ColorIndex = 2
    .Interior.ColorIndex = 14: .Interior.Pattern = xlSolid
End With
Do While sFil <> ""
    i = i + 1: Cells(i, 1).Offset(1) = i: Cells(i, 2).Offset(1) = sFil
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, 2), Address:=ThisWorkbook.path & "\" & sFil
    sFil = Dir
Loop
[a1].CurrentRegion.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

 

[minhhoa]

Để tạo được liên kết từ các tiêu đề như trong file Excel của bạn thì bạn làm như sau nhé
Ví dụ : tạo liên kết cho VB 0001 ở Excel liên kết với file Word VB 0001
Bạn di chuyển chuột đến địa chỉ A2 sau đó bạn bấm vào Insert chọn Hyperlink xuất hiện cửa sổ
Hyperlink Edit sau đọn bấm vào biểu tượng Browse For File sau đó bạn di chuyển đến file Word VB 0001 chọn OK
Bạn có thể tham khảo Video hướng dẫn mình đã tạo


[video=youtube;-2UcKPMx0d0]http://www.youtube.com/watch?v=-2UcKPMx0d0[/video]

Chúc bạn thành công

 

[phamhoan]

Để tạo được liên kết từ các tiêu đề như trong file Excel của bạn thì bạn làm như sau nhé
Ví dụ : tạo liên kết cho VB 0001 ở Excel liên kết với file Word VB 0001
Bạn di chuyển chuột đến địa chỉ A2 sau đó bạn bấm vào Insert chọn Hyperlink xuất hiện cửa sổ
Hyperlink Edit sau đọn bấm vào biểu tượng Browse For File sau đó bạn di chuyển đến file Word VB 0001 chọn OK
Bạn có thể tham khảo Video hướng dẫn mình đã tạo



[video=youtube;-2UcKPMx0d0]http://www.youtube.com/watch?v=-2UcKPMx0d0[/video]

Chúc bạn thành công

vậy em muốn làm với rất nhiều file word như thế thì cũng phải làm hyperlink lần lượt trong Excel ạ ? hay có cách nào nhanh hơn không ạ?

 

[phamhoan]

Theo yêu cầu của bạn, tên file là VB.... nhưng tên VB lại lại lấy ở đâu đó thì theo mình nghĩ là hơi khó (tạm thời chưa nghĩ ra)

Lấy tên các file trong thư mục hiện hành: để file này vào thư mục cần lấy List & Link

Code trong file (boyxin kiếm trên GPE - không nhớ của ai và sửa tý xíu):

Public Sub Get_Files()
Dim i As Double
Dim sFil As String
Application.ScreenUpdating = False
[a1].CurrentRegion.ClearContents
sFil = Dir("*.*")
Cells(1, 1) = "TT": Cells(1, 2) = "File in " & ThisWorkbook.path
With Range("A1:B1")
    .Font.Bold = True:    .Font.ColorIndex = 2
    .Interior.ColorIndex = 14:    .Interior.Pattern = xlSolid
End With
Do While sFil <> ""
    i = i + 1
    Cells(i, 1).Offset(1) = i:    Cells(i, 2).Offset(1) = sFil
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, 2), Address:=ThisWorkbook.path & "\" & sFil
    sFil = Dir
Loop
[a1].CurrentRegion.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Em không hiểu lắm, code này để làm gì hả bác, và chèn như thế nào ạ?

 

[boyxin]

Em không hiểu lắm, code này để làm gì hả bác, và chèn như thế nào ạ?

Bạn xem file đính kèm

Tập tin đính kèm

• 
  Tao list va link.rar

Mình đã gắn code đó trong file đính kèm rồi. để file đó trong thư mục cần lấy danh sách và liên kết rồi mở file tạo List và Link, nhấn nút [Lấy List & Link] rồi xem kết quả

Hy vọng bạn tìm được nhiều điều lý thú và hữu ích

 

[Hai Lúa Miền Tây]

Bạn xem file đính kèm

Tập tin đính kèm

• 
  Tao list va link.rar

Mình đã gắn code đó trong file đính kèm rồi. để file đó trong thư mục cần lấy danh sách và liên kết rồi mở file tạo List và Link, nhấn nút [Lấy List & Link] rồi xem kết quả

Hy vọng bạn tìm được nhiều điều lý thú và hữu ích

Mình xin chỉnh lại tí là ý tác giả muốn lấy danh mục là file *.doc với lại code trên chỉ lấy file có chung folder, mình chỉnh lại dùng dialog lấy ở bất kỳ thư mục mào mình muốn

Public Sub Get_Files()
Dim i As Double
Dim sFil, stDir As String
Application.ScreenUpdating = False

 With Application.FileDialog(msoFileDialogFolderPicker)
          .AllowMultiSelect = False
       If .Show = -1 Then
          stDir = .SelectedItems(1)
       End If
 End With

[a1].CurrentRegion.ClearContents
sFil = Dir(stDir & "\*.doc")
Cells(1, 1) = "TT": Cells(1, 2) = "File in " & stDir
With Range("A1:B1")
    .Font.Bold = True:    .Font.ColorIndex = 2
    .Interior.ColorIndex = 14:    .Interior.Pattern = xlSolid
End With
Do While sFil <> ""
    i = i + 1
    Cells(i, 1).Offset(1) = i:    Cells(i, 2).Offset(1) = sFil
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, 2), Address:=stDir & "\" & sFil
    sFil = Dir()
Loop
[a1].CurrentRegion.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

 

[phamhoan]

Sao mình làm hướng dẫn rồi mà kick vào nút tạo link & liên kết nó lại báo như này thế ạ?

 

[Hai Lúa Miền Tây]

Bạn vào Tools\Macro\Security, chọn Low..., hoặc chọn Medium, đóng hết các file Excel lại, mở file lên (Chọn Enable Macro đối với bạn chọn Security là Medium...), chạy code thử nhé

 

[ndu96081631]

Bài này có thể giải quyết bằng công thức

Các bạn có tin rằng bài này có thể dùng công thức không? Hàm HYPERLINK có thể giải quyết được đấy:
- Gõ đường dẩn đến thư mục chứa file vào cell A1
- Đặt 2 name

FNs =FILES(Sheet1!$A$1&"\*")

Pos =IF(RIGHT(FNs,3)="doc",TRANSPOSE(ROW(INDIRECT("1:"&COUNTA(FNs)))),"")

- Cell A2, gõ công thức:

=IF(ROWS($1:1)>COUNT(Pos),"",INDEX(FNs,,SMALL(Pos,ROWS($1:1))))

- Cell B2, gõ công thức:

=IF($A2="","",HYPERLINK($A$1&"\"&$A2,"File "&ROWS($1:1)))

Lưu ý:
- Để hiển thì 1 tên nào khác tại cột B, có thể liên kết với 1 bảng tra có sẳn
- Giới hạn của name FNs là chứa tối đa 256 phần tử... Tức chỉ cho phép thư mục chứa tối đa 256 file

 

[raisoldier]

Muốn mở rộng ra tất cả các file và folder thì làm sao vậy anh

 

[ndu96081631]

Muốn mở rộng ra tất cả các file và folder thì làm sao vậy anh

Thì dùng code thôi!
Code duyệt file trong thư mục có đầy trên GPE rồi, giờ chỉ cần "ráp" thêm code Hyperlink nữa là xong!

 

[raisoldier]

A ơi, ráp như thế nào a ^^~