Bloggang.com : thaiger_u - การเขียน Wise Search ด้วย VBA บน Excel

การเขียน Wise Search ด้วย VBA บน Excel

การค้นหาข้อมูล เป็นงานที่ทางฝ่าย IT มักจะได้รับการร้องขอ จาก user อยู่บ่อยๆ เป็นงานที่สร้างภาระให้กับฝ่าย IT ไม่ใช่น้อย ถ้ามี Tools ที่ user สามารถเรียกดูข้อมูลได้เองคงเป็นเรื่องที่ดีมาก เพราะนอกจากจะไม่ต้องไปรบกวนงาน IT แล้ว ทาง user สามารถแรียกดูข้อมูลเงื่อนไขต่างๆ ได้เองตลอดเวลา แบบไม่ต้องเกรงใจกัน ทำให้สามารถวิเคราะห์ข้อมูลได้ชัดเจนขึ้น แม่นยำยิ่งขึ้น วันนี้เรามาเขียน macro เพื่อเขียน Wise Search กันดีกว่า ข้อมูลที่ใช้จะทดลอง จะเป็นข้อมูลทะเบียนประวัติบุคลากร จากระบบ HRIS

การเตรียมหน้าจอบน worksheet
1. สร้าง Field List ที่ต้องการดูข้อมูล $A$6:$A$13
2. สร้างเงื่อนไขการเปรีบบเทียบ $B$6:$B$10
3. สร้าง Combo box ที่อ้างอิงไปยัง cell ต่างๆ ของข้อ 1 และตั้งชื่อ Field1,Field2...Field4
4. สร้าง Combo box ที่อ้างอิงไปยัง cell ต่างๆ ของข้อ 2 และตั้งชื่อ Cond1,Cond2..Cond4
5. copy Macro ด้านล่างเพื่อให้ดึงข้อมูล

อธิบายการใข้งานโปรแกรมตามหน้าจอ
-combo box แถวแรกจะเป็นรายการ Field ที่ต้องการแสดง ในรายงาน ตามหมายเลข 1
-combo box แถวที่สอง จะเป็นเงื่อนไขในการเลือก
-ตามตัวอย่างหมายเลข 2 หมายความว่า ขอดูข้อมูลพนักงานทุกคนที่มีรหัสน้อยกว่า 5 โดยในการใช้งานจริงสามารถเลือกเงื่อนไขได้หลายรูปแบบ ตามต้องการ
แล้วสั่ง run macro เพื่อให้ได้ข้อมูลตามภาพ

บทส่งท้าย
การประยุกต์ใช้ Wise Search นั้น สามารถทำกับระบบฐานข้อมูลในระบบอะไรก็ได้ ที่ติดต่อผ่าน ADODB ไม่ว่าจะเป็นระบบบุคคล ระบบบัญชี หรือ ระบบผลิต ขึ้นกับการประยุกต์ใช้ เนื่องจากผู้ใช้จำนวนมากสามารใช้ Excel ได้อย่างดี การประยุกต์ใช้ย่อมทำได้หลากหลายมากขึ้น
หากท่านมีข้อแนะนำ สามารถส่ง email มาได้ที่ thaigroovy at gmail.com

บทความเก่า

Sub WiseSearch()

            Dim pConn As ADODB.Connection
            Dim rRS As ADODB.Recordset

            Set pConn = New ADODB.Connection
            Set rRS = New ADODB.Recordset

            Dim rcmd As New ADODB.Command

            pConn.ConnectionString = "Provider=SQLOLEDB;Data Source=hrms;database=HR_TEST;User ID=sa;Password=pwdhrms;"
            pConn

            rcmd.ActiveConnection = pConn
            Dim ws As Worksheet
            Dim rng As Range

            Dim i As Long
            Dim row As Long
            Dim cl As Integer
            Dim xx As Variant
            cl = 0
            Dim nField As Integer
            ' On Error Resume Next

           Dim dd As DropDown
           Dim sqlText As String

                row = 1
                Worksheets("Sheet2").Activate
                Set ws = Application.ActiveSheet
                sqlText = ""

                ' Gen Condition Text
                Dim whereText As String
                whereText = ""

                For nField = 1 To 4
                        Set ff = ActiveSheet.DropDowns("field" & Trim(Str(nField)))
                        sqlText = sqlText & Cells(4 + ff.Value, 1) & ","

                        Set dd = ActiveSheet.DropDowns("cond" & Trim(Str(nField)))
                        If Cells(4 + dd.Value, 2) = "None" Or Cells(4 + dd.Value, 2) = "" Then
                        Else
                            whereText = whereText & Cells(4 + ff.Value, 1) & Cells(4 + dd.Value, 2) & Cells(9, 2 + nField) & " and "
                        End If
                Next

                ' Start Gen Data

                Worksheets("Sheet3").Activate
                Set ws = Application.ActiveSheet

                rcmd.CommandText = "SELECT " & sqlText & " EmployeeID FROM tEmployee where " & whereText & "1=1"
                Set rRS = rcmd.Execute

                ' Headers
                For i = 0 To rRS.Fields.Count - 1
                    Set rng = ws.Cells(row, i + 1)
                    rng.Value = rRS.Fields(i).Name
                Next i

                ' Data rows

                row = 2

                While Not rRS.EOF
                    For i = 0 To rRS.Fields.Count - 1
                        Set rng = ws.Cells(row, i + 1)

                        If (rRS.Fields(i).Type = adLongVarBinary) Or (rRS.Fields(i).Type = 135) Then
                            rng.Value = ""
                            rng.Value = Str(rRS(i).Value)
                        Else
                            rng.Value = rRS(i).Value

                        End If

                    Next i
                    rRS.MoveNext
                    row = row + 1
                Wend

             Exit Sub
erline:
            rng.Value = "Error"
            Resume Next
End Sub

Create Date : 25 มกราคม 2556
Last Update : 25 มกราคม 2556 21:46:16 น.
Counter : 4894 Pageviews.

0 comments