ลองดูครับ ไม่รู้ต้องการแบบนี้ไหม
ถ้าจะปรับตรงไหนสอบถามได้ครับ
โดยขั้นตอนแรก ใช้การนำข้อมูลจากตาราง work มา Addnew ไปยังตารางที่ 2 คือ WorkExtrackUNIT
โดยจำนวนครั้งเอามาจากการจำนวนของ Unit ในแต่ละ Fullname
Sub AddRowByUnit()
Dim RS As DAO.Recordset
Dim rst As DAO.Recordset
Dim strFullname As String
Dim I As Long
Set rst = CurrentDb.OpenRecordset("Work", dbOpenDynaset)
Set RS = CurrentDb.OpenRecordset("WorkExtrackUNIT", dbOpenDynaset)
rst.MoveFirst
Do Until rst.EOF
strFullname = rst!FullName
For I = 1 To rst!unit
If strFullname = rst!FullName Then
RS.AddNew
RS![FullName] = rst!FullName
RS![HN] = rst!HN
RS!row = "1"
RS.Update
End If
Next
rst.MoveNext
Loop
RS.Close
Set RS = Nothing
End Subขั้นตอนต่อมาใช้การนำข้อมูลที่ได้มาสร้างเป็นแถวเดียว หลายคอลัมน์
โดยใช้ Do until
สั่งเกตุจากขั้นตอนแรกผมจะเพิ่มแถวที่ชื่อ Row เข้าไปด้วยเพื่อไว้เช็คค่าตอน Update ไปยังตาราง
Public Sub ExplodeTable()
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim I As Integer
Dim LastID As Variant
Set DB = CurrentDb
Set RS = DB.OpenRecordset("SELECT WorkExtrackUNIT.row,WorkExtrackUNIT.Fullname, WorkExtrackUNIT.HN FROM WorkExtrackUNIT ORDER BY WorkExtrackUNIT.ID;")
RS.MoveFirst
Do Until RS.EOF
If RS!row <> LastID Then
I = 1
DB.Execute "insert into Workreport (row, box1) values (" & CStr(RS!row) & ", '" & CStr(RS!FullName & vbCrLf & " HN " & RS!HN) & "')", dbFailOnError
Else
I = I + 1
DB.Execute "update Workreport set Box" & CStr(I) & " = '" & CStr(RS!FullName & vbCrLf & " HN " & RS!HN) & "' where row = '" & CStr(RS!row) & "'", dbFailOnError
End If
LastID = RS!row
RS.MoveNext
Loop
RS.Close: Set RS = Nothing
DB.Close: Set DB = Nothing
DoCmd.OpenReport "rptdemo", acViewPreview
End Subแล้วสร้างปุ่มคลิ๊กขึ้นมาซักตัวหนึ่ง ใส่โค้ดให้จัดลำดับการทำงานตั้งแต่เริ่มจนถึงการออกรายงาน
โดยจะสั่งให้ลบข้อมูลในตาราง ชั่วคราวออกก่อนรับข้อมูลใหม่มาแสดงที่รายงานทุกครั้ง
Private Sub Command0_Click()
Dim DB As DAO.Database
Set DB = CurrentDb
DB.Execute "Delete * from WorkExtrackUNIT;"
DB.Execute "Delete * from Workreport;"
Call AddRowByUnit
Call ExplodeTable
DB.Close: Set DB = Nothing
End Sub
