Page 1 of 3

รบกวนตรวจ Code ให้ด้วยครับ

Posted: Sat Apr 01, 2017 2:24 pm
by rich37

Code: Select all

Private Sub CommandButton5_Click() 'ล้างข้อมูล
    Me.TextBox1.Value = ""
    Me.TextBox2.Value = ""
    Me.TextBox3.Value = ""
    Me.TextBox4.Value = ""
    Me.ComboBox3.Value = ""
    Me.ComboBox4.Value = ""
    Me.ComboBox1.Value = ""
    Me.ComboBox2.Value = ""
    Me.TextBox7.Value = ""
    Me.ListBox1.Value = ""
    Me.TextBox1.SetFocus
End Sub
น่าจะเกี่ยวกับ Code ด้านล่างไหมครับหากกดปุ่ม CommandButton5 แล้วไม่สามารถล้างข้อมูลใน ListBox1 ได้ เพราะตัวนี้หรือเปล่า ListBox1.RowSource = "_ListMatch"

Code: Select all

Private Sub TextBox1_Change()
Sheets("Database").Range("K1").Value = TextBox1.Value
[code]ListBox1.RowSource = "_ListMatch"
End Sub[/code]

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Sat Apr 01, 2017 2:42 pm
by rich37

Code: Select all

Private Sub CommandButton5_Click() 'ล้างข้อมูล
    Me.TextBox1.Value = ""
    Me.TextBox2.Value = ""
    Me.TextBox3.Value = ""
    Me.TextBox4.Value = ""
    Me.ComboBox3.Value = ""
    Me.ComboBox4.Value = ""
    Me.ComboBox1.Value = ""
    Me.ComboBox2.Value = ""
    Me.TextBox7.Value = ""
    ListBox1.RowSource = ""
    Me.TextBox1.SetFocus
End Sub
ListBox1.RowSource = "" แก้เป็นแบบนี้ (ถามเองตอบเองเลยครับ)

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Sat Apr 01, 2017 4:36 pm
by rich37
Code 380 ต้องแก้ส่วนไหนครับ

Code: Select all

Private Sub TextBox1_Change()
Sheets("Database").Range("K1").Value = TextBox1.Value
ListBox1.RowSource = "_ListMatch"
End Sub

Private Sub TextBox7_AfterUpdate()
TextBox7.Value = Format(TextBox7.Value, "d mmmm yyyy")
End Sub
Private Sub UserForm_Activate()
   ActiveWindow.WindowState = xlMaximized
End Sub
Private Sub ComboBox1_Change()
    Select Case ComboBox1.ListIndex
        Case 0
        a = "Person!_Type"
        ComboBox1.RowSource = a
        Case 1
        b = "Person!_Person"
        ComboBox2.RowSource = b
        Case 2
        C = "Person!_Worktype"
        ComboBox3.RowSource = C
        Case 4
        D = "Person!_Niti"
        ComboBox4.RowSource = D
    End Select
End Sub

Private Sub CommandButton1_Click() 'search
On Error Resume Next
Dim ws As Worksheet
    Set ws = Worksheets("Database")
Dim myRange As Range
    Set myRange = Worksheets("Database").Range("_Data")
    If Trim(Me.TextBox1.Value) = "" Then
        Me.TextBox1.SetFocus
        MsgBox "¤Ø³ÂѧäÁèä´éãÊè¢éÍÁÙÅ", vbInformation, "Ãкº¤é¹ËÒÊӹǹ"
        Exit Sub
    ElseIf Application.CountIf(ws.Range("_Irow"), Trim(Me.TextBox1.Value)) = 0 Then
        Me.TextBox1.SetFocus
        MsgBox "äÁ辺¢éÍÁÙŤ´Õ " & Me.TextBox1.Value, vbInformation, "Ãкº¤é¹ËÒÊӹǹ"
        Exit Sub
    Else
        TextBox2.Value = _
        Application.WorksheetFunction.VLookup(TextBox1.Value, myRange, 2, False)
        TextBox3.Value = _
        Application.WorksheetFunction.VLookup(TextBox1.Value, myRange, 3, False)
        TextBox4.Value = _
        Application.WorksheetFunction.VLookup(TextBox1.Value, myRange, 4, False)
        ComboBox3.Value = _
        Application.WorksheetFunction.VLookup(TextBox1.Value, myRange, 5, False)
        ComboBox4.Value = _
        Application.WorksheetFunction.VLookup(TextBox1.Value, myRange, 6, False)
        ComboBox1.Value = _
        Application.WorksheetFunction.VLookup(TextBox1.Value, myRange, 7, False)
        ComboBox2.Value = _
        Application.WorksheetFunction.VLookup(TextBox1.Value, myRange, 8, False)
        TextBox7.Value = Format(Application.WorksheetFunction.VLookup(TextBox1.Value, myRange, 9, False), "d mmmm yyyy")
    End If
    Me.ComboBox3.SetFocus
End Sub
Private Sub CommandButton2_Click() 'add
    Dim irow  As Long
    Dim ws As Worksheet
    Set ws = Worksheets("Database")
    irow = ws.Cells(Rows.Count, 2) _
        .End(xlUp).Offset(1, 0).Row
    If Trim(Me.TextBox1.Value) = "" Then
        Me.TextBox1.SetFocus
        MsgBox "¤Ø³ÂѧäÁèä´éãÊè¢éÍÁÙÅ", vbInformation, "Ãкº¤é¹ËÒÊӹǹ"
        Exit Sub
    Else
        ws.Cells(irow, 2).Value = Me.TextBox1.Value
        ws.Cells(irow, 3).Value = Me.TextBox2.Value
        ws.Cells(irow, 4).Value = Me.TextBox3.Value
        ws.Cells(irow, 5).Value = Me.TextBox4.Value
        ws.Cells(irow, 6).Value = Me.ComboBox3.Value
        ws.Cells(irow, 7).Value = Me.ComboBox4.Value
        ws.Cells(irow, 8).Value = Me.ComboBox1.Value
        ws.Cells(irow, 9).Value = Me.ComboBox2.Value
        ws.Cells(irow, 10).Value = Me.TextBox7.Value
        Me.TextBox1.Value = ""
        Me.TextBox2.Value = ""
        Me.TextBox3.Value = ""
        Me.TextBox4.Value = ""
        Me.ComboBox3.Value = ""
        Me.ComboBox4.Value = ""
        Me.ComboBox1.Value = ""
        Me.ComboBox2.Value = ""
        Me.TextBox7.Value = ""
        Me.TextBox1.SetFocus
        MsgBox "à¾ÔèÁ¢éÍÁÙÅàÃÕºÃéÍÂ", vbInformation, "Ãкº¤é¹ËÒÊӹǹ"
    ActiveWorkbook.Save
    End If
    Call Runon
End Sub
Private Sub CommandButton3_Click() 'close
       ActiveWorkbook.Close SaveChanges:=True
        Application.Quit
End Sub
Private Sub CommandButton4_Click() ' edit
    Dim irow As Long
    Dim ws As Worksheet
    Set ws = Worksheets("Database")
    If Trim(Me.TextBox1.Value) = "" Then
        MsgBox "¤Ø³ÂѧäÁèä´éãÊè¢éÍÁÙÅ", vbInformation, "Ãкº¤é¹ËÒÊӹǹ"
        Exit Sub
Else
        irow = _
        Application.WorksheetFunction.Match(TextBox1.Value, Sheets("Database").Range("B2:B1000000"), 0) + 1
    ws.Cells(irow, 2).Value = Me.TextBox1.Value
    ws.Cells(irow, 3).Value = Me.TextBox2.Value
    ws.Cells(irow, 4).Value = Me.TextBox3.Value
    ws.Cells(irow, 5).Value = Me.TextBox4.Value
    ws.Cells(irow, 6).Value = Me.ComboBox3.Value
    ws.Cells(irow, 7).Value = Me.ComboBox4.Value
    ws.Cells(irow, 8).Value = Me.ComboBox1.Value
    ws.Cells(irow, 9).Value = Me.ComboBox2.Value
    ws.Cells(irow, 10).Value = Me.TextBox7.Value
    Me.TextBox1.Value = ""
    Me.TextBox2.Value = ""
    Me.TextBox3.Value = ""
    Me.TextBox4.Value = ""
    Me.ComboBox3.Value = ""
    Me.ComboBox4.Value = ""
    Me.ComboBox1.Value = ""
    Me.ComboBox2.Value = ""
    Me.TextBox7.Value = ""
    Me.TextBox1.SetFocus
    MsgBox "á¡é䢢éÍÁÙÅàÃÕºÃéÍÂ", vbInformation, "Ãкº¤é¹ËÒÊӹǹ"
    ActiveWorkbook.Save
     End If
End Sub

Private Sub CommandButton5_Click()
    Me.TextBox1.Value = ""
    Me.TextBox2.Value = ""
    Me.TextBox3.Value = ""
    Me.TextBox4.Value = ""
    Me.ComboBox3.Value = ""
    Me.ComboBox4.Value = ""
    Me.ComboBox1.Value = ""
    Me.ComboBox2.Value = ""
    Me.TextBox7.Value = ""
    Me.ListBox1.Value = ""
    Me.TextBox1.SetFocus
End Sub

Private Sub CommandButton6_Click()
UserForm2.Show
End Sub

Private Sub CommandButton7_Click()
UserForm3.Show
End Sub

Private Sub UserForm_Initialize()
        Me.StartUpPosition = 0
        Me.Top = 0
        Me.Left = 0
        a = "Person!_Type"
        ComboBox1.RowSource = a
        b = "Person!_Person"
        ComboBox2.RowSource = b
        C = "Person!_Worktype"
        ComboBox3.RowSource = C
        D = "Person!_Niti"
        ComboBox4.RowSource = D
'        ListBox1.RowSource = "_ListMatch"
End Sub

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Sat Apr 01, 2017 5:49 pm
by snasui
:D ช่วยเขียนหัวกระทู้ให้สื่อถึงปัญหาที่จะถาม Code ที่แนบมานั้นต้องการจะทำอะไรครับ ควรแนบไฟล์ตัวอย่างมาด้วย ตัดมาเฉพาะที่ติดปัญหาจะได้เข้าถึงปัญหาโดยไว

หากต้องการ Clear ค่าใน ListBox จากการกำหนด RowSource ให้กำหนดเป็น ListBox1.RowSource="" ครับ

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Sat Apr 01, 2017 6:16 pm
by rich37
snasui wrote::D ช่วยเขียนหัวกระทู้ให้สื่อถึงปัญหาที่จะถาม Code ที่แนบมานั้นต้องการจะทำอะไรครับ ควรแนบไฟล์ตัวอย่างมาด้วย ตัดมาเฉพาะที่ติดปัญหาจะได้เข้าถึงปัญหาโดยไว

หากต้องการ Clear ค่าใน ListBox จากการกำหนด RowSource ให้กำหนดเป็น ListBox1.RowSource="" ครับ
ขอโทษครับสำหรับการตั้งหัวกระทู้
ไฟล์แนบขนาดใหญ่เกินไปครับไม่สามาถแนบมาได้ ส่วนเรื่องที่ติดปัญหาคือ error Code 380 ต้องแก้ส่วนไหนครับ ระหว่าง

Code: Select all

Private Sub UserForm_Initialize()
        Me.StartUpPosition = 0
        Me.Top = 0
        Me.Left = 0
        a = "Person!_Type"
        ComboBox1.RowSource = a
        b = "Person!_Person"
        ComboBox2.RowSource = b
        C = "Person!_Worktype"
        ComboBox3.RowSource = C
        D = "Person!_Niti"
        ComboBox4.RowSource = D
        'ListBox1.RowSource = "_ListMatch"
End Sub
หรือ

Code: Select all

Private Sub TextBox1_Change()
    Sheets("Database").Range("K1").Value = TextBox1.Value
    ListBox1.RowSource = "_ListMatch"
End Sub

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Sat Apr 01, 2017 6:56 pm
by snasui
:D การแนบไฟล์ให้ทำมาเป็นตัวอย่างไฟล์เสียก่อนโดยตัดมาเฉพาะที่เป็นปัญหา ไม่ควรแนบไฟล์จริงมาถามตอบกันครับ

ผมยังไม่ทราบเลยว่าต้องการจะทำอะไร ที่ตอบไปด้านบนเป็นการสันนิษฐาน ช่วยแจ้งมาให้ชัดเจนอีกรอบว่าต้องการจะทำอะไรครับ

หากต้องการจะ Set RowSource ด้วย Range Name ที่ชื่อว่า "_ListMatch" ก็ให้อ้างเป็น ListBox1.RowSource=Range("_ListMatch").Address เช่นนี้เป็นต้นครับ

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Sat Apr 01, 2017 8:50 pm
by rich37
snasui wrote::D การแนบไฟล์ให้ทำมาเป็นตัวอย่างไฟล์เสียก่อนโดยตัดมาเฉพาะที่เป็นปัญหา ไม่ควรแนบไฟล์จริงมาถามตอบกันครับ

ผมยังไม่ทราบเลยว่าต้องการจะทำอะไร ที่ตอบไปด้านบนเป็นการสันนิษฐาน ช่วยแจ้งมาให้ชัดเจนอีกรอบว่าต้องการจะทำอะไรครับ

หากต้องการจะ Set RowSource ด้วย Range Name ที่ชื่อว่า "_ListMatch" ก็ให้อ้างเป็น ListBox1.RowSource=Range("_ListMatch").Address เช่นนี้เป็นต้นครับ
ยังเออเร่อเหมือนเดิมครับ ไฟล์ขนาดเกินครับ ต้องฝากไว้ที่ google drive แทนครับ
แก้ไขไม่ให้ขึ้น #NUM หากค้นหาไม่เจอ ให้เป็น Listbox เปล่าๆ
https://drive.google.com/file/d/0B8Cigt ... sp=sharing

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Sat Apr 01, 2017 11:22 pm
by snasui
:D ตัวอย่าง Code ครับ

Code: Select all

Private Sub TextBox1_Change()
    On Error Resume Next
    Sheets("Database").Range("K1").Value = TextBox1.Value
    If Not IsError(Sheets("Database").Range("M2").Value) Then
        ListBox1.RowSource = "_listMatch"
    Else
        ListBox1.RowSource = ""
    End If
End Sub

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Mon Apr 03, 2017 9:16 am
by rich37
snasui wrote::D ตัวอย่าง Code ครับ

Code: Select all

Private Sub TextBox1_Change()
    On Error Resume Next
    Sheets("Database").Range("K1").Value = TextBox1.Value
    If Not IsError(Sheets("Database").Range("M2").Value) Then
        ListBox1.RowSource = "_listMatch"
    Else
        ListBox1.RowSource = ""
    End If
End Sub
ขอบคุณครับอาจารย์ หากผมต้องการเลือกรายการใน lixtbox ให้มาแสดงใน textbox ตามช่องรายการ จะต้องปรับปรุง Code ในส่วนไหนบ้างครับ

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Mon Apr 03, 2017 5:26 pm
by rich37

Code: Select all

Private Sub ListBox1_Click()
TextBox1.Value = ListBox1.Column(0, ListBox1.ListIndex)
TextBox2.Value = ListBox1.Column(1, ListBox1.ListIndex)
TextBox3.Value = ListBox1.Column(2, ListBox1.ListIndex)
TextBox4.Value = ListBox1.Column(3, ListBox1.ListIndex)
ComboBox3.Value = ListBox1.Column(4, ListBox1.ListIndex)
ComboBox4.Value = ListBox1.Column(5, ListBox1.ListIndex)
ComboBox1.Value = ListBox1.Column(6, ListBox1.ListIndex)
ComboBox2.Value = ListBox1.Column(7, ListBox1.ListIndex)
TextBox7.Value = ListBox1.Column(8, ListBox1.ListIndex)
End Sub
จาก Code ด้านบน จะไม่มีปัญหาถ้าให้แสดงแค่ textbox1-4 แต่หากแสดงทั้งหมดจะเออเร่อตั้งแต่ComboBox3 ลงไป

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Mon Apr 03, 2017 9:12 pm
by snasui
:D ตัวอย่าง Code ครับ

Code: Select all

dim i as integer
i=me.listbox1.listindex
if me.listbox1.selected(i)=true then
   textbox1.text=me.listbox1,list(i,0)
   textbox2.text=me.listbox1,list(i,1)
   '...
end if

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Tue Apr 04, 2017 6:32 am
by rich37
snasui wrote::D ตัวอย่าง Code ครับ

Code: Select all

dim i as integer
i=me.listbox1.listindex
if me.listbox1.selected(i)=true then
   textbox1.text=me.listbox1,list(i,0)
   textbox2.text=me.listbox1,list(i,1)
   '...
end if
หลังจากนำ Code มาปรับแก้ไขแล้ว ( me.listbox1,list(i,0) >me.listbox1.list(i,0) ) สามารถคลิกเลือกรายการจาก Listbox ได้ตามต้องการ แต่มีปัญหาที่ตามมาคือ ไม่สามารถแก้ไขหรือปรับปรุงได้จาก Textbox1 ผมเลยสร้าง Textbox ขึ้นมาใหม่อีก1กล่องเพื่อเอาไว้ใช้สำหรับค้นหาโดยเฉพาะ แต่ก็ยังติดปัญหาเดิมคือไม่สามารถแก้ไขรายการที่เลือกมาจาก Listbox ได้เหมือนเดิมครับ

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Tue Apr 04, 2017 7:34 pm
by snasui
:D ตัวอย่าง Code ครับ

Code: Select all

Dim i As Integer
Dim j As Integer

Private Sub ListBox1_Click()
    i = Me.ListBox1.ListIndex
    j = Application.Match(Me.ListBox1.List(i, 0), Sheets("Database").Range("b:b"), 0)
    If Me.ListBox1.Selected(i) = True Then
        TextBox1.Text = Me.ListBox1.List(i, 0)
        TextBox2.Text = Me.ListBox1.List(i, 1)
        TextBox3.Text = Me.ListBox1.List(i, 2)
        TextBox4.Text = Me.ListBox1.List(i, 3)
        TextBox5.Text = Me.ListBox1.List(i, 8)
        ComboBox1.Text = Me.ListBox1.List(i, 6)
        ComboBox2.Text = Me.ListBox1.List(i, 7)
        ComboBox3.Text = Me.ListBox1.List(i, 4)
        ComboBox4.Text = Me.ListBox1.List(i, 5)
    End If
End Sub

Private Sub TextBox1_Change()
    Sheets("Database").Cells(j, "b").Value = TextBox1.Text
End Sub

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Tue Apr 04, 2017 7:50 pm
by rich37
snasui wrote::D ตัวอย่าง Code ครับ

Code: Select all

Dim i As Integer
Dim j As Integer

Private Sub ListBox1_Click()
    i = Me.ListBox1.ListIndex
    j = Application.Match(Me.ListBox1.List(i, 0), Sheets("Database").Range("b:b"), 0)
    If Me.ListBox1.Selected(i) = True Then
        TextBox1.Text = Me.ListBox1.List(i, 0)
        TextBox2.Text = Me.ListBox1.List(i, 1)
        TextBox3.Text = Me.ListBox1.List(i, 2)
        TextBox4.Text = Me.ListBox1.List(i, 3)
        TextBox5.Text = Me.ListBox1.List(i, 8)
        ComboBox1.Text = Me.ListBox1.List(i, 6)
        ComboBox2.Text = Me.ListBox1.List(i, 7)
        ComboBox3.Text = Me.ListBox1.List(i, 4)
        ComboBox4.Text = Me.ListBox1.List(i, 5)
    End If
End Sub

Private Sub TextBox1_Change()
    Sheets("Database").Cells(j, "b").Value = TextBox1.Text
End Sub
Run-Time Error13 ครับ

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Tue Apr 04, 2017 8:41 pm
by snasui
:D ช่วยอธิบายประกอบด้วยว่าใช้กับไฟล์ไหนอย่างไร ผมทดสอบแล้วไม่พบว่าติดปัญหาครับ

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Tue Apr 04, 2017 9:02 pm
by rich37
snasui wrote::D ช่วยอธิบายประกอบด้วยว่าใช้กับไฟล์ไหนอย่างไร ผมทดสอบแล้วไม่พบว่าติดปัญหาครับ
ไฟล์ที่ อัพใน #12 ครับ

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Tue Apr 04, 2017 9:19 pm
by snasui
:D ใช้ Code ที่ผมปรับไปให้กับไฟล์เดิมก่อนที่จะสร้าง TextBox เพิ่ม ไม่จำเป็นต้องเพิ่ม TextBox แต่อย่างใด

เนื่องจาก ListBox เป็นการใช้ RowSource ไม่ใช่ ListBox ที่เพิ่มค่าเข้าไปเองที่จะแก้แต่ละตำแหน่งได้อย่างอิสระ และ RowSource คือค่าในเซลล์ การจะแก้ ListBox ต้องแก้ที่เซลล์มันจะส่งผลมาที่ ListฺBox ให้เอง

Code ที่ผมทำตัวอยา่งไปให้นั้นเป็นการชี้ไปยังบรรทัดที่เราคลิกเลือกใน ListBox ว่าในเซลล์ที่ชีต Database เป็นบรรทัดใดโดยใช้ตัวแปร j มารับค่าบรรทัดจากค่าใน TexBox1 เนื่องจาก TextBox1 ได้รับผลกระทบจากการคลิกเลือกใน Listbox

หากแก้ TextBox1 จะกระทบกับค่าในบรรทัดของชีต Database ที่เป็นค่าต้นทาง และจะส่งผลมายัง ListBox เอง

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Tue Apr 04, 2017 9:33 pm
by rich37
snasui wrote::D ใช้ Code ที่ผมปรับไปให้กับไฟล์เดิมก่อนที่จะสร้าง TextBox เพิ่ม ไม่จำเป็นต้องเพิ่ม TextBox แต่อย่างใด

เนื่องจาก ListBox เป็นการใช้ RowSource ไม่ใช่ ListBox ที่เพิ่มค่าเข้าไปเองที่จะแก้แต่ละตำแหน่งได้อย่างอิสระ และ RowSource คือค่าในเซลล์ การจะแก้ ListBox ต้องแก้ที่เซลล์มันจะส่งผลมาที่ ListฺBox ให้เอง

Code ที่ผมทำตัวอยา่งไปให้นั้นเป็นการชี้ไปยังบรรทัดที่เราคลิกเลือกใน ListBox ว่าในเซลล์ที่ชีต Database เป็นบรรทัดใดโดยใช้ตัวแปร j มารับค่าบรรทัดจากค่าใน TexBox1 เนื่องจาก TextBox1 ได้รับผลกระทบจากการคลิกเลือกใน Listbox

หากแก้ TextBox1 จะกระทบกับค่าในบรรทัดของชีต Database ที่เป็นค่าต้นทาง และจะส่งผลมายัง ListBox เอง
รบกวนอาจารย์อัพไฟล์ที่อาจารย์ทำส่งให้ผมได้ไหมครับ เพราะไฟล์ที่ผมมีมัน ขึ้นเออเร่อตามรูปครับ

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Tue Apr 04, 2017 9:35 pm
by snasui
:D แนบไฟล์ที่ขึ้น Error กลับมาจะได้ช่วยดูให้ได้ครับ

Re: รบกวนตรวจ Code ให้ด้วยครับ

Posted: Tue Apr 04, 2017 10:02 pm
by rich37
snasui wrote::D แนบไฟล์ที่ขึ้น Error กลับมาจะได้ช่วยดูให้ได้ครับ
:thup: