เรียนถามอ.สุภาพและเพื่อน Access ทุกท่าน
ผมลองไปใช้งานดูมาสองวันแล้วพอเข้าใจได้บางส่วนอยากจะขอถามเป็นจุดๆนะครับคือผลของค่าเฉลี่ยใน word ทำไมไม่เท่ากับ excel และตรงไหนครับที่ระบุตำแหน่งที่เอาข้อมูลมา Average ครับ

จากตัวอย่างต้นฉบับ จะมีการนำ เงือนเดือน มารวมกันครับ ตรงบันทัดนี้

.Selection.InsertFormula Formula:="=SUM(ABOVE)", NumberFormat:="#, ##0.00"

โดยจัดรูปแบให้มีทศนิยม 2 ตำแหน่ง และมีเครื่องหมาย , ขั้นด้วย

ความหมายของโค้ดแบบย่อๆ นะครับ

Private Sub cmdExport2Word_Click()
Dim dbs As Database, rst As Recordset, I As Integer
Dim objWord As Object, strNum As Integer, strName As String, dblSal As String
Dim strFileName As String

Set dbs = CurrentDb ' กำหนดตัวแปร dbs ให้ชี้ไปยังฐานข้อมูลปัจจุบัน
Set rst = dbs.OpenRecordset("tblSalary") ' เปิดตารางชื่อ tblSalary

If Not rst.EOF Then ' ถ้ามีข้อมูลอย่างน้อย 1 รายการขึ้นไป
rst.MoveLast
rst.MoveFirst ' วิ่งไปยังข้อมูลแรก แล้วกลับมาข้อมูลแรก เพื่อให้ได้ข้อมูลที่ถูกต้อง โดยเฉพาะ rst.RecordCount
strFileName = ap_AppDir + "empword.doc" ' กำหนดให้ไฟล์เป้าหมาย empword.doc ซึ่งอยู่ในห้องเดียวกับที่เก็บไฟล์ mdb
Set objWord = CreateObject("Word.Application") ' กำหนดให้เปิดโปรแกรม Word
With objWord
.Visible = True ' ให้แสดงโปรแกรม Word ให้ผู้ใช้เห็น
.Documents.Open FileName:=strFileName ' เปิดไฟล์ word เป้าหมาย
.Selection.EndKey Unit:=6 'wdStory, simulate Ctrl + End to go to the end of this page ย้ายตำแหน่งไปยังท้ายเอกสาร
' where we want to insert a table with 3 columns เพื่อสร้างตารางที่มี 3 คอลัมน์ และ 2 แถว
.ActiveDocument.Tables.Add Range:=.Selection.Range, NumRows:=2, NumColumns:= _
3, DefaultTableBehavior:=1, AutoFitBehavior:=0
.Application.Keyboard (1054) ' Press ~ to change to Thai เปลี่ยน Keyboard ให้เป็นภาไทย
.Selection.TypeText Text:="ลำดับที่" ' ใส่ข้อความในตารางแถวแรก
.Selection.ParagraphFormat.Alignment = 1 'wdAlignParagraphCenter
.Selection.MoveRight Unit:=12 'wdCell, press Tab key
.Selection.TypeText Text:="ชื่อ"
.Selection.ParagraphFormat.Alignment = 1 'dAlignParagraphCenter
.Selection.MoveRight Unit:=12
.Selection.TypeText Text:="เงินเดือน"
.Selection.ParagraphFormat.Alignment = 1
.Selection.MoveLeft Unit:=1, Count:=3, Extend:=1
.Selection.HomeKey Unit:=5, Extend:=1
.Selection.MoveLeft Unit:=1, Count:=2, Extend:=1
.Selection.Font.Bold = True 'wdToggle
.Selection.MoveLeft Unit:=1, Count:=1
.Selection.MoveDown Unit:=5, Count:=1
For I = 1 To rst.RecordCount ' ลูปข้อมูลใน Access ตั้งแต่ข้อมูลแรกเป็นต้นไป
strNum = I ' ให้ส่งค่า I กับ strNum ไว้
.Selection.TypeText CStr(strNum)
.Selection.ParagraphFormat.Alignment = 1
.Selection.MoveRight Unit:=12
.Application.Keyboard (1033)
strName = rst(1) ' เก็บรายชื่อในฟีลด์ที่ 2 ไว้
.Selection.TypeText Text:=strName ' เขียนลงไปใน Word
.Selection.ParagraphFormat.Alignment = 0 ' AlignLeft
.Selection.MoveRight Unit:=12
dblSal = Format(rst(2), "#, ##0.00") ' ส่งตัวเลยเงินเดือนไปเก็บไว้กับตัวแปร dblSal โดยกำหนดให้แสดง #, ##0.00
.Selection.TypeText Text:=CStr(dblSal) ' แปลงตัวเลขให้เป็น String
.Selection.ParagraphFormat.Alignment = 2 ' AlignRight
.Selection.MoveRight Unit:=12
rst.MoveNext ' วิ่งไปยังข้อมูลต่อไป
Next I
.Selection.MoveRight Unit:=12
.Selection.HomeKey Unit:=5, Extend:=1
.Selection.MoveLeft Unit:=2, Count:=1, Extend:=1
.Selection.Cells.Merge ' วิ่งลงไปในแถวต่อไปของตารางใน Word แล้วรวม 2 cells เข้าด้วยกัน
.Application.Keyboard (1054)
.Selection.TypeText Text:="รวมเป็นเงินทั้งสิ้น" ' แล้วใส่ข้อความนี้ลงไป
.Selection.ParagraphFormat.Alignment = 1 ' AlignCenter
.Selection.MoveRight Unit:=12
.Selection.InsertFormula Formula:="=SUM(ABOVE)", NumberFormat:="#, ##0.00" ' ย้าย cursor ไปยังคอลัมน์ต่อไป เพื่อใส่สูตร =SUM(ABOVE) คือให้รวมตัวเลขของแถวที่อยู่ข้างบนทั้งหมด
.Selection.ParagraphFormat.Alignment = 2 ' AlignRight
End With

MsgBox "Finished" ' แสดงข้อความนี้เมื่อเสร็จงาน
' Don't save the file ' เก็บขยะทั้งหลายก่อนให้เรียบร้อย
objWord.ActiveDocument.Saved = True
objWord.ActiveDocument.Close
' Quit Word
objWord.Quit
Set objWord = Nothing

Else
MsgBox "ไม่มีข้อมูล", vbOKOnly, "No Records!"
End If

Set rst = Nothing
Set dbs = Nothing

End Sub

:)

ขอบคุณครับอ.ขอถามเพิ่มครับ
1. ผมลองเปลี่ยนจากการรวมเป็นการหาค่าเฉลี่ย โดยปรับมาใช้กับงานที่โรงงานผมแต่ผลที่ได้ออกมา Word และ excel จะต่างกันประมาณ .2
>codeที่ใช้ในOffice 2000
Dim dbs As DAO.Database, rst As DAO.Recordset, i As Integer
Dim objWord As Object, strNum As Integer, strName As String, dblSal As String, xxx As String
Dim strFileName As String
Dim strSQL As String
strSQL = "SELECT VacDate.[Cart No],VacDate.Average,VacDate.Date " & _
"FROM VacDate " & _
"WHERE VacDate.Date Between " & CDbl(Me.txtStart) & " And " & CDbl(Me.txtEnd) & " AND VacDate.[Cart No]=" & Me.txtCart & " AND VacDate.Average Is Not Null"

'"WHERE VacDate.Date Between #" & Format(Me.txtStart, "mm / dd / yyyy") & "# And #" & Format(Me.txtEnd, "mm / dd / yyyy") & "# AND VacDate.[Cart No]=" & Me.txtCart & " AND VacDate.Average Is Not Null"
MsgBox strSQL

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL)
If Not rst.EOF Then
rst.MoveLast
rst.MoveFirst
strFileName = ap_AppDir + "empword.doc"
Set objWord = CreateObject("Word.Application")
With objWord
.Visible = True
.Documents.Open FileName:=strFileName ' Range:=Selection.Range
.Selection.EndKey Unit:=6 'wdStory, simulate Ctrl + End to go to the end of this page
' where we want to insert a table with 3 columns
.ActiveDocument.Tables.Add Range:=.Selection.Range, NumRows:=2, NumColumns:= _
4, DefaultTableBehavior:=1, AutoFitBehavior:=0
.Application.Keyboard (1054) ' Press ~ to change to Thai
.Selection.TypeText Text:="ลำดับที่"
.Selection.ParagraphFormat.Alignment = 1 'wdAlignParagraphCenter
.Selection.MoveRight Unit:=12 'wdCell, press Tab key
.Selection.TypeText Text:="ชื่อเครื่องจักร"
.Selection.ParagraphFormat.Alignment = 1 'dAlignParagraphCenter
.Selection.MoveRight Unit:=12
.Selection.TypeText Text:="ค่า Vacuum(Pa)"
.Selection.ParagraphFormat.Alignment = 1
.Selection.MoveRight Unit:=12
.Selection.TypeText Text:="วันที่"
.Selection.ParagraphFormat.Alignment = 1 'dAlignParagraphCenter
.Selection.MoveLeft Unit:=1, Count:=3, Extend:=1
.Selection.HomeKey Unit:=5, Extend:=1
.Selection.MoveLeft Unit:=1, Count:=2, Extend:=1
.Selection.Font.Bold = True 'wdToggle
.Selection.MoveLeft Unit:=1, Count:=1
.Selection.MoveDown Unit:=5, Count:=1
.Selection.MoveLeft Unit:=12

For i = 1 To rst.RecordCount
strNum = i
.Selection.TypeText CStr(strNum)
.Selection.ParagraphFormat.Alignment = 1 '1
.Selection.MoveRight Unit:=12
.Application.Keyboard (1033)
strName = rst(0)
.Selection.TypeText Text:=strName
.Selection.ParagraphFormat.Alignment = 0 '0 ' AlignLeft
.Selection.MoveRight Unit:=12
dblSal = Format(rst(1), "#,##0.00")
.Selection.TypeText Text:=CStr(dblSal)
.Selection.ParagraphFormat.Alignment = 2 '2 ' AlignRight
.Selection.MoveRight Unit:=12
xxx = Format(rst(2), "dd/mm/yyyy")
.Selection.TypeText Text:=xxx
.Selection.ParagraphFormat.Alignment = 1 ' AlignLeft
.Selection.MoveRight Unit:=12

rst.MoveNext
Next i
'.Run MacroName:="ShowFont"
.Selection.MoveRight Unit:=12
.Selection.HomeKey Unit:=5, Extend:=1
.Selection.MoveLeft Unit:=3, Count:=1, Extend:=1
.Selection.Cells.Merge
.Application.Keyboard (1054)
.Selection.TypeText Text:="Average "
.Selection.ParagraphFormat.Alignment = 1 ' AlignCenter
.Selection.MoveRight Unit:=12
.Selection.InsertFormula Formula:="=Average(ABOVE)", NumberFormat:="#,##0.00"
.Selection.ParagraphFormat.Alignment = 2 ' AlignRight
End With

MsgBox "Finished"
' Don't save the file
objWord.ActiveDocument.Saved = True
objWord.ActiveDocument.Close
' Quit Word
objWord.Quit
Set objWord = Nothing

Else
MsgBox "ไม่มีข้อมูล", vbOKOnly, "No Records!"
End If

Set rst = Nothing
Set dbs = Nothing
Exit Sub
Err_msgbox:
If Err.Number = 3075 Then
MsgBox "ตรวจสอบข้อมูลที่ท่านต้องการใหม่อีกครั้ง ", vbExclamation, "Error 94,3075"
Else
MsgBox "ติดต่อผู้ดูแลระบบ", vbCritical
End If