สร้าง form ในเอ็กเซลแล้วเพิ่มเติมมันขึ้นข้อความแบบนี้

[godman]

อาจารย์ครับ ผมได้ฟอร์มและอยากจะได้แบบนี้ คือ กดปั้บแล้วแสดงฟอร์มให้ user กรอก แล้วข้อมูลก็ไปลงใน pivot table แต่พอผมไปดัดแปลงฟอร์มมัน error ขอความช่วยแหลือแก้ไข code ให้ด้วยครับ ขอบคุณครับ

[snasui]

ตรง Sub UserForm_Initialize ให้ทำการ Mark Comment ตามด้านล่าง แล้วทดสอบดูใหม่ครับ

Code: Select all

Private Sub UserForm_Initialize()
    Dim cPart As Range
    Dim cLoc As Range
    Dim ws As Worksheet
    Set ws = Worksheets("LookupLists")
    
    'Me.txtDate.Value = Format(Date, "Medium Date")
    'Me.txtQty.Value = 1
    Me.cboPart.SetFocus
    Me.cboPart.Value = "Select"
    Me.cboLocation.Value = "Select"
    
End Sub

[godman]

ขอบคุณครับ แต่ผมแกะ code ไม่ออก เพราะผมอยากให้เลือกที่ Shift ใน form แล้วข้อมูลของ Shift ซึ่งมาจากคอลัมพ์ F sheet lookuplist มาทำอย่างไรครับ ต่อยอดถึง เมื่อเลือก Product ก็ให้ข้อมูลในช่อง G ของชี้ต LOOKUPLIJST มาด้วย

เพราะผมสังเกตดูว่า เมื่อเลือก shift แล้วรายการที่แสดงเหมือนกันกับ อันข้างบน เช่นเดียวกันกับ product ก็เหมือนัน สาเหตุเพราะผมอยากปรับสไตล์ให้เข้ากับองค์กรผม ผมเลย copy มาแต่ไม่ทราบจะไปแก้ไข code ที่ตรงใหน

[snasui]

สำหรับ VBA แล้วจำเป็นต้องเขียน Code และปรับปรุงเองได้บ้างครับ เนื่องจากผมจะเน้นตอบเฉพาะที่ติดปัญหา กรณียังไม่เคยใช้ VBA ควรหาหนังสือมาอ่านและเริ่มบันทึก Macro เพื่อดูตัวอย่างการทำงานของ Code ซึ่งต้องค่อย ๆ เรียนรู้ครับ

หากจะให้เร็วกว่านั้นก็ต้องให้ผู้ที่มีความรู้เกี่ยวกับ VBA ช่วยปรับปรุงให้ ติดตรงไหนก็ค่อยมาถามกันได้เรื่อย ๆ ครับ

[godman]

ตอนนี้ ผมได้เขียน code ในส่วนที่ผมต้องการเพิ่มคือ Shift (กะทำงาน) และ Product(ชื่อของสินค้า) แต่ปราฏว่ามัน error ขอความแนะนำว่าผมเขียนถูกต้องไหมครับ คือผมเพิ่มในส่วนนี้ไป
With ws
.Cells(lRow, 1).Value = Me.cboPart.Value
.Cells(lRow, 2).Value = Me.cboPart.List(lPart, 1)
.Cells(lRow, 3).Value = Me.cboLocation.Value
.Cells(lRow, 4).Value = Me.cboShift.Value ผม
.Cells(lRow, 5).Value = Me.cboProduct.Value ผม
.Cells(lRow, 6).Value = Me.txtDate.Value
.Cells(lRow, 7).Value = Me.txtQty.Value
End With

'clear the data
Me.cboPart.Value = "Select"
Me.cboLocation.Value = "Select"
Me.cboShift.Value = "Select" ผม
Me.cboProduct.Value = "Select" ผม
Me.txtDate.Value = Format(Date, "Medium Date")
Me.txtQty.Value = 1
Me.cboPart.SetFocus

[snasui]

ช่วยทำ Code ให้เป็น Code ด้วยครับ จะได้สะดวกในการอ่านหรือ Copy ไปใช้ ดูตัวอย่างจากที่นี่ครับ viewtopic.php?f=3&t=1187

สำหรับ Error ที่เกิดขึ้น เนื่องจากชื่อของ Control กับที่ใช้ใน Code ไม่ตรงกัน ต้องเปลี่ยนให้ตรงกันก่อน เช่นตามภาพด้านล่าง ComboBox2 ต้องเปลี่ยนเป็น cboProduct เนื่องจากนำ Userform ของผูือื่นมาปรับ ใน Code หลาย ๆ ที่จึงอ้างถึง cboProduct และไม่รู้จัก ComboBox2 ครับ

[godman]

ผมได้แก้ไข code ในทุกสิ่งแล้วครับ แต่ผมสงสัยว่าทำไมมันขึ้น error ว่า invalid procedure ประมาณนี้ ขอความกรุณาชี้แนะด้วยคับว่าเขียนตรงใหนผิด

Code: Select all

Option Explicit
PrivateSub cboProduct_Change()
End Sub
Private Sub cboLocation_Change()
End Sub
Private Sub cboPart_Change()
End Sub

Private Sub cmdAdd_Click()
Dim lRow As Long
Dim lPart As Long
Dim ws As Worksheet
Set ws = Worksheets("PartsData")

'find  first empty row in database
lRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(1, 0).Row
  
lPart = Me.cboPart.ListIndex

'check for a part number
If Trim(Me.cboPart.Value) = "" Then
  Me.cboPart.SetFocus
  MsgBox "Please enter a part number"
  Exit Sub
End If

'copy the data to the database
With ws
  .Cells(lRow, 1).Value = Me.cboPart.Value
  .Cells(lRow, 2).Value = Me.cboPart.List(lPart, 1)
  .Cells(lRow, 3).Value = Me.cboLocation.Value
  .Cells(lRow, 4).Value = Me.CboProduct.Value
  .Cells(lRow, 5).Value = Me.txtDate.Value
  .Cells(lRow, 6).Value = Me.txtQty.Value
End With

'clear the data
Me.cboPart.Value = "Select"
Me.cboLocation.Value = "Select"
Me.CboProduct.Value = "Select"
Me.txtDate.Value = Format(Date, "Medium Date")
Me.txtQty.Value = 1
Me.cboPart.SetFocus

End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub Label1_Click()

End Sub

Private Sub txtDate_Change()

End Sub

Private Sub txtQty_Change()

End Sub

Private Sub UserForm_Initialize()
Dim cPart As Range
Dim cLoc As Range
Dim cPro As Range
Dim ws As Worksheet
Set ws = Worksheets("LookupLists")

Me.txtDate.Value = Format(Date, "Medium Date")
Me.txtQty.Value = 1
Me.cboPart.SetFocus
Me.cboPart.Value = "Select"
Me.cboLocation.Value = "Select"
Me.CboProduct.Value = "Select"

End Sub

[snasui]

แก้ตรงด้านล่างระหว่าง Private กับ Sub ให้มีวรรคด้วยครับ

เดิม

Code: Select all

Option Explicit
PrivateSub cboProduct_Change()
End Sub

แก้เป็น

Code: Select all

Option Explicit
Private Sub cboProduct_Change()
End Sub

หรือลบทิ้งไปก็ได้เพราะว่าไมได้มี Code ใดอยู่ด้านใน

[godman]

ว้าว สุดยอด ขอบคุณครับ ที่ช่วยผม

[godman]

ขอความช่วยเหลือ ครับ 2 ชั่วโมงแล้วที่หาสาเหตุไม่ได้ คื เมื่อกดปุ่ม add ใน form เพื่อบันทึกข้อมูลลง database มันขึ้นว่า Syntax Error และยังไม่สามารถบันทึกข้อมูลได้ และ ผมอยากปรับความยาวของ combo box ที่ชื่อว่า cbotrainer ให้มันสั้นลง ผมไม่รู้ว่าต้องปรับที่ตรงใหน

Code: Select all

Option Explicit

Private Sub cboHowToEval_Change()

End Sub

Private Sub cboOperation1_Change()

End Sub

Private Sub cboOperation2_Change()

End Sub

Private Sub cboOperation3_Change()

End Sub

Private Sub cboProduct_Change()

End Sub

Private Sub cboTrainer_Change()

End Sub

Private Sub txtClassTitle_Change()

End Sub

Private Sub txtCourseID_Change()

End Sub

Private Sub txtDay_Change()

End Sub

Private Sub txtFull_Change()

End Sub

Private Sub txtHour_Change()

End Sub

Private Sub txtSubClass_Change()

End Sub

Private Sub txtSubClassTitle_Change()

End Sub
Private Sub cmdAdd_Click()
Dim 1Row As Long
Dim 1Trainer As Long
Dim ws As Worksheet
Set ws = Worksheets("CourseData")

'find first empty row in database
lRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'check for a employee number
If Trim(Me.cboTrainer.Value) = "" Then
Me.cboTrainer.SetFocus
MsgBox "Please enter a employee number"
Exit Sub
End If

'copy the data to the database
With ws
.Cells(lRow, 1).Value = Me.cboTrainer.Value
.Cells(lRow, 2).Value = Me.cboTrainer.List(lTrainer, 1)
.Cells(lRow, 3).Value = Me.txtCourseID.Value
.Cells(lRow, 4).Value = Me.txtClassTitle.Value
.Cells(lRow, 5).Value = Me.txtSubClass.Value
.Cells(lRow, 6).Value = Me.txtSubClassTitle.Value
.Cells(lRow, 7).Value = Me.cboHowToEval.Value
.Cells(lRow, 8).Value = Me.txtFull.Value
.Cells(lRow, 9).Value = Me.txtDay.Value
.Cells(lRow, 10).Value = Me.txtHour.Value
.Cells(lRow, 11).Value = Me.cboProduct.Value
.Cells(lRow, 12).Value = Me.cboOperation1.Value
.Cells(lRow, 13).Value = Me.cboOperation2.Value
.Cells(lRow, 14).Value = Me.cboOperation3.Value


End With
'clear the data

Me.txtCourseID.Value = ""
Me.txtClassTitle.Value = ""
Me.txtSubClass.Value = ""
Me.txtSubClassTitle.Value = ""
Me.cboHowToEval.Value = "Select"
Me.txtFull.Value = ""
Me.txtDay.Value = ""
Me.txtHour.Value = ""
Me.cboProduct.Value = "Select"
Me.cboOperation1.Value = "Select"
Me.cboOperation2.Value = "Select"
Me.cboOperation3.Value = "Select"
Me.cboTrainer.Value = "Select"
Me.cboTrainer.SetFocus
End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim cHowToEval As Range
Dim cProduct As Range
Dim cOperation As Range
Dim cTrainer As Range
Dim ws As Worksheet
Set ws = Worksheets("LookupLists")

Me.txtCourseID.Value = ""
Me.txtClassTitle.Value = ""
Me.txtSubClass.Value = ""
Me.txtSubClassTitle.Value = ""
Me.cboHowToEval.Value = "Select"
Me.txtFull.Value = ""
Me.txtDay.Value = ""
Me.txtHour.Value = ""
Me.cboProduct.Value = "Select"
Me.cboOperation1.Value = "Select"
Me.cboOperation2.Value = "Select"
Me.cboOperation3.Value = "Select"
Me.cboTrainer.Value = "Select"
Me.cboTrainer.SetFocus

End Sub

[snasui]

ช่วยทำ Code ให้เป็น Code ด้วยครับ จะได้สะดวกในการอ่านหรือ Copy ไปใช้ ดูตัวอย่างจากที่นี่ครับ viewtopic.php?f=3&t=1187...

[niwat2811]

ลองเปลี่ยน

Private Sub cmdAdd_Click()
Dim 1Row As Long
Dim 1Trainer As Long

เป็น

Private Sub cmdAdd_Click()
Dim lRow As Long
Dim lTrainer As Long

ดูก่อนครับ

[godman]

ใช้ได้เลยครับ ทำไมเก่งจัง
คำถามต่อมา สงสัยว่า พอกด enter ปั้บ ทำไมกระโดดไปช่อง สุดท้ายเลย ไม่ไล่ไปทีละอัน ตามลำดับ

[godman]

ผมเจอแล้วครับ ขอบคุณครับ