Excel Expert Loader

Download Excel Expert Loader Add-In
Download Excel Expert Loader 2000 Add-In

ใช้ Tools > Add-Ins > Browse หา ExpertLoader.xla แล้วเปิดขึ้นใช้งานจากเมนู Tools หรือกด Ctrl+Shift+L เพื่อเปิดใช้ Excel Expert Loader

คุณสมบัติ

• แสดงรายชื่อ File ที่อยู่ใน Folder เดียวกันกับ Active Workbook

• หาก Active Workbook ยังไม่ได้ Save จะแสดงรายชื่อ File ที่อยู่ใน Folder เดียวกันกับ ExpertLoader.xla

• เลือกแสดงรายชื่อ File ที่อยู่ใน Folder จาก Default file Location ก็ได้

• ใช้แสดงรายชื่อ Workbook ที่กำลังเปิดใช้งานอยู่ หรือเลือกแสดงชื่อ Sheet หรือ Range Name

• ดับเบิ้ลคลิ้กที่ชื่อเพื่อแสดงข้อมูลที่เลือก

• Excel Expert Loader 2000 ใช้กับ Excel 2000 ขึ้นไป ทำงานแบบ Modeless ช่วยให้ทำงานอื่นในขณะเดียวกันได้ด้วย

Sub ShowLoader()
'เปิดใช้ Excel ExpertLoader
    UserForm1.Show
End Sub

Sub ShowFileinThisPath()
'แสดงรายชื่อ File ใน Folder
    On Error Resume Next
    Dim Directory As String, f As String
    Dim FileSource As String
    UserForm1.Caption = "Excel Expert File List"
    UserForm1.ListBox1.Clear
    UserForm1.ListBox1.RowSource = ""
    If UserForm1.CheckBox1.Value = True Then
        Directory = Application.DefaultFilePath & "\"
        FileSource = "Default Folder >"
        Else
        If ActiveWorkbook.Path <> "" Then
            Directory = ActiveWorkbook.Path & "\"
            FileSource = "Active Workbook Folder >"
            Else
            Directory = ThisWorkbook.Path & "\"
            FileSource = "Expert Loader Folder >"
        End If
    End If
    UserForm1.ListBox1.AddItem FileSource
    f = Dir(Directory) 'use this line for all types or next  line for only xls
'   f = Dir(Directory & "*.xls")
    UserForm1.ListBox1.AddItem f
    Do While f <> ""
        f = Dir
        If f <> "" And f <> ThisWorkbook.Name Then
            UserForm1.ListBox1.AddItem f
        End If
    Loop
    UserForm1.Show
End Sub

Sub ShowOpenedWorkbook()
'แสดงรายชื่อ Workbook ที่กำลังเปิดอยู่
    On Error Resume Next
    Dim WB As Workbook
    UserForm1.Caption = "Excel Expert Workbook List"
    UserForm1.ListBox1.Clear
    For Each WB In Workbooks
        If WB.Name <> ThisWorkbook.Name Then
            UserForm1.ListBox1.AddItem WB.Name
        End If
    Next
    UserForm1.Show
End Sub

Sub ShowSheetsinActiveWorkbook()
'แสดงรายชื่อ Sheet
    On Error Resume Next
    Dim WS As Variant
    UserForm1.Caption = "Excel Expert Sheet List"
    UserForm1.ListBox1.Clear
    For Each WS In Sheets
            UserForm1.ListBox1.AddItem WS.Name
    Next
    UserForm1.Show
End Sub

Sub ShowNamesinActiveWorkbook()
'แสดงรายชื่อ Range Name
    On Error Resume Next
    Dim RN As Variant
    UserForm1.Caption = "Excel Expert Name List"
    UserForm1.ListBox1.Clear
    For Each RN In ActiveWorkbook.Names
            UserForm1.ListBox1.AddItem RN.Name
    Next
    UserForm1.Show
End Sub

Sub CloseWithoutSave()
'Close file without save
    On Error Resume Next
    MyChoice = MsgBox("Close this file without save", vbOKCancel + vbDefaultButton2, "Excel Expert Loader")
    If MyChoice = vbOK Then
        If ThisWorkbook.Name <> ActiveWorkbook.Name Then
            ActiveWorkbook.Close (False)
            Else
            MsgBox "You have to close ExpertLoader.xls by yourself or Exit Excel", , "Excel Expert Loader"
        End If
    End If
End Sub

Sub AddLoaderMenu()
'เพิ่มเมนูต่อท้ายเมนู Tools
    Dim ToolsMenu As CommandBarPopup
    Dim NewMenuItem As CommandBarButton
    Call DeleteLoaderMenu
    Set ToolsMenu = CommandBars(1).FindControl(ID:=30007)
    If ToolsMenu Is Nothing Then
        MsgBox "Cannot add Excel Expert Loader to Tools Menu"
        Exit Sub
    Else
        Set NewMenuItem = ToolsMenu.Controls.Add(Type:=msoControlButton)
        With NewMenuItem
            .Caption = "Excel Expert &Loader         Ctrl+Shift+L"
            .OnAction = "ShowLoader"
            .BeginGroup = True
        End With
    End If
End Sub

Sub DeleteLoaderMenu()
'ลบเมนูท้ายเมนู Tools
    On Error Resume Next
    CommandBars(1).FindControl(ID:=30007). _
        Controls("Excel Expert &Loader         Ctrl+Shift+L").Delete
End Sub

Event Code

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'แสดง Item ที่เลือกเมื่อกดดับเบิ้ลคลิ้ก
    Dim MyChoice As Variant, Directory As String
    On Error Resume Next
    MyChoice = ListBox1.Value
    If MyChoice = "Excel Expert Training" Then UserForm2.Show
    Select Case UserForm1.Caption
        Case "Excel Expert File List"
                If UserForm1.CheckBox1.Value = True Then
                    Directory = Application.DefaultFilePath & "\"
                Else
                    If ActiveWorkbook.Path <> "" Then
                        Directory = ActiveWorkbook.Path & "\"
                        Else
                        Directory = ThisWorkbook.Path & "\"
                    End If
                End If
                Workbooks.Open Filename:=Directory & MyChoice
        Case "Excel Expert Workbook List"
                Windows(MyChoice).Activate
        Case "Excel Expert Sheet List"
                Sheets(MyChoice).Select
        Case "Excel Expert Name List"
                Application.Goto Reference:=MyChoice
    End Select
End Sub

Private Sub SortButtonClick()
'Bubble Sort
    On Error Resume Next
    Dim i As Integer, j As Integer
    Dim Temp
    For i = 0 To ListBox1.ListCount - 2
        For j = i + 1 To ListBox1.ListCount - 1
            If ListBox1.List(i, 0) > ListBox1.List(j, 0) Then
                Temp = ListBox1.List(j, 0)
                ListBox1.List(j, 0) = ListBox1.List(i, 0)
                ListBox1.List(i, 0) = Temp
            End If
        Next j
    Next i
End Sub