Showing posts with label tạo List. Show all posts
Showing posts with label tạo List. Show all posts

Sunday, April 14, 2019

Chương trình tự tổng hợp các thư mục trong đường dẫn đã cho và tạo List cây thư mục giống hệt trên Web

Link tải chương trình : Tại đây
Code sử dụng:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim xRow As Long
Dim s As String


Dim xDirect$, xFname$, InitialFoldr$

InitialFoldr$ = "C:\Users\cuongnh\Desktop\"

With Application.FileDialog(msoFileDialogFolderPicker)

.InitialFileName = Application.DefaultFilePath & "\"

.Title = "Please select a folder to list Files from"

.InitialFileName = InitialFoldr$

.Show

s = .SelectedItems(1)

Target.Value = s

Cells(Target.Row - 1, Target.Column + 1).Select

If .SelectedItems.Count <> 0 Then

xDirect$ = .SelectedItems(1) & "\"

xFname$ = Dir(xDirect$, 7)

    Do While xFname$ <> ""
    'ActiveCell.Offset(xRow).Select
    ActiveCell.Offset(1).Select
    ActiveCell = xFname$

    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=.SelectedItems(1) & "\" & xFname$
    ActiveCell.Offset(0, -1) = s
    'xRow = xRow + 1

    xFname$ = Dir

    Loop

End If

End With

ActiveSheet.PivotTables("PivotTable6").PivotCache.Refresh

End Sub

Over 50 Ebooks Excel and VBA free Download

1. Statistics and Probability for Engineering Applications With Microsoft Excel by W.J. DeCoursey - PDF Free Download Download Siz...