#1
by godman » Thu Oct 11, 2012 6:58 pm
สวัสดีครับอาจารย์
พอดีว่า ผมได้สร้างโค้ดขึ้นมาโดยนำมาจากที่อื่นแล้วความต้องการของผมคือให้มันไปสุดท้ายที่ชี้ต ชื่อ firstpage เซลล์ H5 ผมก็เขียนโค้ดเพิ่มเติมตรงท้ายสุดว่า
Sub GOTO....
....ตามโค้ดที่ผมแนบมา แต่ปรากฏว่าพอรันแล้วมันยังจบอยู่ที่ชี้ต pivottable อยู่ ผมไม่รู้จะต้องเปลี่ยนที่ตรงใหนมันจึงจะไปจบที่ชี้ตดังกล่าวได้ครับ
Code: Select all
Dim iRow
Dim Counter
Dim myFile As Scripting.File
Sub ListFiles()
On Error Resume Next
Call Setup
Call ListMyFiles(Range("Folder"), Range("Include_Subfolders"))
Call SortRange
Call HideUnwantedCols
Call DisplayOrder
Call RefreshPivot
End Sub
Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Dim MyObject As Scripting.FileSystemObject
On Error Resume Next
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
For Each myFile In mySource.Files
Counter = 1
For i = 1 To 11
Call GetAttribute(i)
Next
If iRow > Range("Stop_After") Then Exit Sub
Application.StatusBar = "File Number: " & iRow
iRow = iRow + 1
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True)
Next
End If
End Sub
Sub Setup()
Sheets("Files").Select
Cells.ClearContents
Cells.EntireColumn.Hidden = False
iCol = 1
iRow = 2
Cells(1, iCol) = "Attributes"
iCol = iCol + 1
Cells(1, iCol) = "DateCreated"
iCol = iCol + 1
Cells(1, iCol) = "DateLastAccessed"
iCol = iCol + 1
Cells(1, iCol) = "DateLastModified"
iCol = iCol + 1
Cells(1, iCol) = "Drive"
iCol = iCol + 1
Cells(1, iCol) = "Name"
iCol = iCol + 1
Cells(1, iCol) = "ParentFolder"
iCol = iCol + 1
Cells(1, iCol) = "Path"
iCol = iCol + 1
Cells(1, iCol) = "ShortName"
iCol = iCol + 1
Cells(1, iCol) = "Size"
iCol = iCol + 1
Cells(1, iCol) = "Type"
For iCol = 1 To 11
Columns(iCol).NumberFormat = Range("Format").Offset(iCol).NumberFormat
Next
End Sub
Function GetAttribute(AttributeNumber)
If Range("What_To_Show").Offset(Counter, 0).Font.Bold = True Then
Select Case AttributeNumber
Case 1
Cells(iRow, Counter).Value = myFile.Attributes
Case 2
Cells(iRow, Counter).Value = myFile.DateCreated
Case 3
Cells(iRow, Counter).Value = myFile.DateLastAccessed
Case 4
Cells(iRow, Counter).Value = myFile.DateLastModified
Case 5
Cells(iRow, Counter).Value = myFile.Drive
Case 6
Cells(iRow, Counter).Value = myFile.Name
Case 7
Cells(iRow, Counter).Value = myFile.ParentFolder
Case 8
Cells(iRow, Counter).Value = myFile.Path
Case 9
Cells(iRow, Counter).Value = myFile.ShortName
Case 10
Cells(iRow, Counter).Value = myFile.Size
Case 11
Cells(iRow, Counter).Value = myFile.Type
End Select
End If
Counter = Counter + 1
End Function
Sub SortRange()
With ActiveWorkbook.Worksheets("Files").Sort
.SortFields.Clear
For i = 1 To 11
Set rngFoundIt = Sheets("Main").Columns(Range("Sort_Order").Column).Find(i, LookIn:=xlValues, LookAt:=xlWhole)
If Not rngFoundIt Is Nothing Then
.SortFields.Add Key:=Cells(2, rngFoundIt.Row - Range("Sort_Order").Row), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End If
Next
.SetRange Range("A1").CurrentRegion
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Cells.EntireColumn.AutoFit
End Sub
Sub DisplayOrder()
End Sub
Sub HideUnwantedCols()
For i = 1 To 11
If Range("What_To_Show").Offset(i, 0).Font.Bold = False Then
Sheets("files").Columns(i).Hidden = True
End If
Next
End Sub
Sub RefreshPivot()
Sheets("pivot").Select
ActiveSheet.PivotTables(1).PivotCache.Refresh
End Sub
Sub GotoFirstPage()
Sheet("FirstPage").Select
Range("h5").Select
End Sub
- Attachments
-
Program list all file Test.zip
- Filetest
- (114.51 KiB) Downloaded 9 times
สวัสดีครับอาจารย์
พอดีว่า ผมได้สร้างโค้ดขึ้นมาโดยนำมาจากที่อื่นแล้วความต้องการของผมคือให้มันไปสุดท้ายที่ชี้ต ชื่อ firstpage เซลล์ H5 ผมก็เขียนโค้ดเพิ่มเติมตรงท้ายสุดว่า
Sub GOTO....
....ตามโค้ดที่ผมแนบมา แต่ปรากฏว่าพอรันแล้วมันยังจบอยู่ที่ชี้ต pivottable อยู่ ผมไม่รู้จะต้องเปลี่ยนที่ตรงใหนมันจึงจะไปจบที่ชี้ตดังกล่าวได้ครับ
[code]Dim iRow
Dim Counter
Dim myFile As Scripting.File
Sub ListFiles()
On Error Resume Next
Call Setup
Call ListMyFiles(Range("Folder"), Range("Include_Subfolders"))
Call SortRange
Call HideUnwantedCols
Call DisplayOrder
Call RefreshPivot
End Sub
Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Dim MyObject As Scripting.FileSystemObject
On Error Resume Next
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
For Each myFile In mySource.Files
Counter = 1
For i = 1 To 11
Call GetAttribute(i)
Next
If iRow > Range("Stop_After") Then Exit Sub
Application.StatusBar = "File Number: " & iRow
iRow = iRow + 1
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True)
Next
End If
End Sub
Sub Setup()
Sheets("Files").Select
Cells.ClearContents
Cells.EntireColumn.Hidden = False
iCol = 1
iRow = 2
Cells(1, iCol) = "Attributes"
iCol = iCol + 1
Cells(1, iCol) = "DateCreated"
iCol = iCol + 1
Cells(1, iCol) = "DateLastAccessed"
iCol = iCol + 1
Cells(1, iCol) = "DateLastModified"
iCol = iCol + 1
Cells(1, iCol) = "Drive"
iCol = iCol + 1
Cells(1, iCol) = "Name"
iCol = iCol + 1
Cells(1, iCol) = "ParentFolder"
iCol = iCol + 1
Cells(1, iCol) = "Path"
iCol = iCol + 1
Cells(1, iCol) = "ShortName"
iCol = iCol + 1
Cells(1, iCol) = "Size"
iCol = iCol + 1
Cells(1, iCol) = "Type"
For iCol = 1 To 11
Columns(iCol).NumberFormat = Range("Format").Offset(iCol).NumberFormat
Next
End Sub
Function GetAttribute(AttributeNumber)
If Range("What_To_Show").Offset(Counter, 0).Font.Bold = True Then
Select Case AttributeNumber
Case 1
Cells(iRow, Counter).Value = myFile.Attributes
Case 2
Cells(iRow, Counter).Value = myFile.DateCreated
Case 3
Cells(iRow, Counter).Value = myFile.DateLastAccessed
Case 4
Cells(iRow, Counter).Value = myFile.DateLastModified
Case 5
Cells(iRow, Counter).Value = myFile.Drive
Case 6
Cells(iRow, Counter).Value = myFile.Name
Case 7
Cells(iRow, Counter).Value = myFile.ParentFolder
Case 8
Cells(iRow, Counter).Value = myFile.Path
Case 9
Cells(iRow, Counter).Value = myFile.ShortName
Case 10
Cells(iRow, Counter).Value = myFile.Size
Case 11
Cells(iRow, Counter).Value = myFile.Type
End Select
End If
Counter = Counter + 1
End Function
Sub SortRange()
With ActiveWorkbook.Worksheets("Files").Sort
.SortFields.Clear
For i = 1 To 11
Set rngFoundIt = Sheets("Main").Columns(Range("Sort_Order").Column).Find(i, LookIn:=xlValues, LookAt:=xlWhole)
If Not rngFoundIt Is Nothing Then
.SortFields.Add Key:=Cells(2, rngFoundIt.Row - Range("Sort_Order").Row), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End If
Next
.SetRange Range("A1").CurrentRegion
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Cells.EntireColumn.AutoFit
End Sub
Sub DisplayOrder()
End Sub
Sub HideUnwantedCols()
For i = 1 To 11
If Range("What_To_Show").Offset(i, 0).Font.Bold = False Then
Sheets("files").Columns(i).Hidden = True
End If
Next
End Sub
Sub RefreshPivot()
Sheets("pivot").Select
ActiveSheet.PivotTables(1).PivotCache.Refresh
End Sub
Sub GotoFirstPage()
Sheet("FirstPage").Select
Range("h5").Select
End Sub
[/code]