:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser

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

ฟอรัมถาม-ตอบปัญหาการใช้งาน Macro และ VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
rich37
Member
Member
Posts: 89
Joined: Wed Feb 01, 2017 4:06 pm

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

#1

Post 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]
rich37
Member
Member
Posts: 89
Joined: Wed Feb 01, 2017 4:06 pm

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

#2

Post 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 = "" แก้เป็นแบบนี้ (ถามเองตอบเองเลยครับ)
rich37
Member
Member
Posts: 89
Joined: Wed Feb 01, 2017 4:06 pm

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

#3

Post 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
Attachments
Untitled2.png
Untitled2.png (112.6 KiB) Viewed 292 times
Untitled3.png
Untitled3.png (89.71 KiB) Viewed 292 times
User avatar
snasui
Site Admin
Site Admin
Posts: 31205
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:

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

#4

Post by snasui »

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

หากต้องการ Clear ค่าใน ListBox จากการกำหนด RowSource ให้กำหนดเป็น ListBox1.RowSource="" ครับ
rich37
Member
Member
Posts: 89
Joined: Wed Feb 01, 2017 4:06 pm

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

#5

Post 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
User avatar
snasui
Site Admin
Site Admin
Posts: 31205
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:

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

#6

Post by snasui »

:D การแนบไฟล์ให้ทำมาเป็นตัวอย่างไฟล์เสียก่อนโดยตัดมาเฉพาะที่เป็นปัญหา ไม่ควรแนบไฟล์จริงมาถามตอบกันครับ

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

หากต้องการจะ Set RowSource ด้วย Range Name ที่ชื่อว่า "_ListMatch" ก็ให้อ้างเป็น ListBox1.RowSource=Range("_ListMatch").Address เช่นนี้เป็นต้นครับ
rich37
Member
Member
Posts: 89
Joined: Wed Feb 01, 2017 4:06 pm

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

#7

Post 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
Attachments
Untitled.jpg
Untitled.jpg (226.35 KiB) Viewed 275 times
User avatar
snasui
Site Admin
Site Admin
Posts: 31205
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:

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

#8

Post 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
Attachments
ระบบค้นหาสำนวน.zip
RowSourceFix
(498.44 KiB) Downloaded 25 times
rich37
Member
Member
Posts: 89
Joined: Wed Feb 01, 2017 4:06 pm

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

#9

Post 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 ในส่วนไหนบ้างครับ
rich37
Member
Member
Posts: 89
Joined: Wed Feb 01, 2017 4:06 pm

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

#10

Post 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 ลงไป
Attachments
111.jpg
111.jpg (90.2 KiB) Viewed 251 times
222.jpg
222.jpg (88.46 KiB) Viewed 251 times
333.jpg
333.jpg (86.86 KiB) Viewed 251 times
User avatar
snasui
Site Admin
Site Admin
Posts: 31205
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:

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

#11

Post 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
rich37
Member
Member
Posts: 89
Joined: Wed Feb 01, 2017 4:06 pm

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

#12

Post 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 ได้เหมือนเดิมครับ
Attachments
ระบบค้นหาสำนวน.rar
(497.31 KiB) Downloaded 15 times
111.jpg
111.jpg (272.04 KiB) Viewed 244 times
User avatar
snasui
Site Admin
Site Admin
Posts: 31205
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:

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

#13

Post 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
rich37
Member
Member
Posts: 89
Joined: Wed Feb 01, 2017 4:06 pm

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

#14

Post 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 ครับ
Attachments
222.jpg
222.jpg (166.16 KiB) Viewed 223 times
333.jpg
333.jpg (167.29 KiB) Viewed 223 times
User avatar
snasui
Site Admin
Site Admin
Posts: 31205
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:

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

#15

Post by snasui »

:D ช่วยอธิบายประกอบด้วยว่าใช้กับไฟล์ไหนอย่างไร ผมทดสอบแล้วไม่พบว่าติดปัญหาครับ
rich37
Member
Member
Posts: 89
Joined: Wed Feb 01, 2017 4:06 pm

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

#16

Post by rich37 »

snasui wrote::D ช่วยอธิบายประกอบด้วยว่าใช้กับไฟล์ไหนอย่างไร ผมทดสอบแล้วไม่พบว่าติดปัญหาครับ
ไฟล์ที่ อัพใน #12 ครับ
Attachments
111.jpg
111.jpg (49.74 KiB) Viewed 217 times
User avatar
snasui
Site Admin
Site Admin
Posts: 31205
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:

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

#17

Post by snasui »

:D ใช้ Code ที่ผมปรับไปให้กับไฟล์เดิมก่อนที่จะสร้าง TextBox เพิ่ม ไม่จำเป็นต้องเพิ่ม TextBox แต่อย่างใด

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

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

หากแก้ TextBox1 จะกระทบกับค่าในบรรทัดของชีต Database ที่เป็นค่าต้นทาง และจะส่งผลมายัง ListBox เอง
rich37
Member
Member
Posts: 89
Joined: Wed Feb 01, 2017 4:06 pm

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

#18

Post 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 เอง
รบกวนอาจารย์อัพไฟล์ที่อาจารย์ทำส่งให้ผมได้ไหมครับ เพราะไฟล์ที่ผมมีมัน ขึ้นเออเร่อตามรูปครับ
User avatar
snasui
Site Admin
Site Admin
Posts: 31205
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:

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

#19

Post by snasui »

:D แนบไฟล์ที่ขึ้น Error กลับมาจะได้ช่วยดูให้ได้ครับ
rich37
Member
Member
Posts: 89
Joined: Wed Feb 01, 2017 4:06 pm

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

#20

Post by rich37 »

snasui wrote::D แนบไฟล์ที่ขึ้น Error กลับมาจะได้ช่วยดูให้ได้ครับ
:thup:
Attachments
ระบบค้นหาสำนวน.rar
(469.9 KiB) Downloaded 14 times
Post Reply