[VB6] แจกโค้ดการพิมพ์ใบแจ้งหนี้ออกกระดาษครึ่ง A4 ร่วมกับ FarPoint Spread เพื่อทำการแก้ไขข้อมูลได้
http://www.g2gnet.com/webboard/images/vb6/AR2PrintBillA5.pngจากโค้ดตัวอย่างครั้งก่อน แจกโค้ดการพิมพ์ใบแจ้งหนี้ห้องพัก/อพาร์ทเมนท์ ออกกระดาษครึ่ง A4 เป็นการนำข้อมูลจาก Excel แบบแถวเดียวมาพิมพ์ แต่อาศัยการเลื่อนตำแหน่งหลัก ซึ่งปกติคนทั่วๆไปมักไม่ค่อยได้ใช้งานกันสักเท่าไหร่ (แต่แอดมินจำเป็นและบ่อยครั้งมาก 5555+) ... คราวนี้มาดูการป้อนข้อมูลในตารางคล้ายๆกับ Excel โดยกระทำผ่านทาง FarPoint Spread เพื่ออำนวยความสะดวกให้กับผู้ใช้ (End Users) ได้ดียิ่งขึ้น ซึ่งเราจะต้องมีการล็อค หรือเช็คค่าต่างๆในแต่ละเซลล์ให้ถูกต้องเสียก่อน จึงจะส่งออกไปพิมพ์รายงานแบบ Hard Copy ด้วย ActiveReports 2.0 ... บทความและโค้ดชุดนี้ จะเน้นไปที่การควบคุม FarPoint Spread เพราะส่วนการออกรายงาน และการใช้ Initial File (INI) ต่างก็เหมือนเดิมครับ แอดมินไม่พูดมาก เจ็บคอ 5555+ ...
หากท่านบังเอิญผ่านมาเจอเว็บไซต์แห่งนี้ ต้องดูรายละเอียดตามลิ้งค์ด้านล่างนี้ก่อนด้วยครับ
แจกฟรีโค้ดการพิมพ์ใบแจ้งค่าใช้จ่าย แบบกระดาษครึ่ง A4 ด้วย FarPoint Spread และ ActiveReports 2.0
การป้อนข้อมูลรายละเอียดการขายสินค้าเข้าสู่ตาราง FarPoint Spread
ดาวน์โหลด FarPoint Spread COM 8 (Update 8.0.21) (สำหรับสมาชิกเท่านั้น)
มาดูโค้ดในส่วนของฟอร์มหลัก ...
' / --------------------------------------------------------------------------------
' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
' / eMail : thongkorn@hotmail.com
' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
' / Facebook: https://www.facebook.com/g2gnet (For Thailand)
' / Facebook: https://www.facebook.com/commonindy (Worldwide)
' / Purpose: Print bill on paper size A5.
' / Microsoft Visual Basic 6.0 (SP1) + FarPoint Spread 8.0
' /
' / This is open source code under @CopyLeft by Thongkorn Tubtimkrob.
' / You can modify and/or distribute without to inform the developer.
' / --------------------------------------------------------------------------------
Option Explicit
Dim strCell1 As String
Dim strCell2 As String
Private Sub cmdPrint_Click()
Dim rptPrint As Object
'// ActiveReports Setup
Set rptPrint = New arSlipA5
Set Me.ARViewerSlip.object = rptPrint
'// Zoom 90%
ARViewerSlip.Zoom = 90
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyF7: Call cmdPrint_Click
Case vbKeyF10:Unload Me
End Select
End Sub
Private Sub Form_Load()
Me.Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
txtFirstName.Text = "นางสาวฮานามิ"
txtLastName.Text = "อิชิตันกรีนที"
txtMonth.Text = "สิงหาคม 2561"
txtRoomNo.Text = "A111"
' ตั้งค่าเริ่มต้นให้กับ Spread
Call SetupSpread
Call DemoData
'// โฟกัสไปยังเซลล์ที่ต้องการ
fp.SetActiveCell 4, 1
End Sub
' ==========================================================
' โปรแกรมย่อยที่กำหนดค่าคุณสมบัติ (Properties) ต่างๆ ให้กับ Spread
Sub SetupSpread()
' ==========================================================
' แสดงแถบแสงหรือไม่แสดง
fp.OperationMode = OperationModeNormal
'fp.OperationMode = OperationModeSingle ' แถบ Selection
'fp.OperationMode = OperationModeRead ' ไม่มีแถบ
'fp.OperationMode = OperationModeRow
' สามารถจัดเรียง หรือ Sort Order บนหัวคอลัมภ์ได้
fp.UserColAction = UserColActionSort
' ปรับหน่วยวัด
'fp.UnitType = UnitTypeNormal
'fp.UnitType = UnitTypeTwips
'fp.UnitType = UnitTypeVGABase ' ค่าตั้งต้น (Default) วัดหน่วย Pixel แบบใน .NET ใช้
' การปรับความสูงของแถวทุกๆแถว (ค่า -1 หมายถึงทุกแถวครับ)
fp.RowHeight(-1) = 20 '390
'fp.Appearance = AppearanceFlat ' = Appearance3D
fp.AppearanceStyle = AppearanceStyleEnhanced
' เวลากด F2 เพื่อแก้ไขข้อมูลในแต่ละเซลล ์ให้เลือกข้อมูลทั้งหมด หรือสามารถเริ่มคีย์ค่าใหม่ได้ทันที
fp.EditModeReplace = True
'fp.GridSolid = True
' กำหนดให้หลักสุงสุดจำนวน 5 หลัก
fp.MaxCols = 5
fp.MaxRows = 9
' กรณีของการ UnBound Control ต้องมาปรับรูปแบบก่อนครับ
With fp
' ปรับความกว้างของแต่ละหลักโดยอัตโนมัติ ... แล้วค่อยปรับทีละหลักอีกก็ได้
'.DAutoSizeCols = DAutoSizeColsBest
' หลักแรก คือ หลักที่ 0 ... จะเป็นการแสดงหมายเลขแถว เพื่ออ้างอิงในลักษณะ Excel เช่น
' A10 ก็คือหลัก A แถวที่ 10 ... ในกรณีที่เรามองแบบ Excel
'.ColWidth(1) = 0
.SetText 0, 0, "รายการชำระเงิน"
.SetText 1, 0, "PK" '/ Reserve
.SetText 2, 0, "หน่วยเริ่มต้น"
.SetText 3, 0, "หน่วยสุดท้าย"
.SetText 4, 0, "ราคาต่อหน่วย"
.SetText 5, 0, "รวมจำนวนเงิน"
' Set Width
.ColWidth(0) = 22
.ColWidth(1) = 0
.ColWidth(2) = 17
.ColWidth(3) = 17
.ColWidth(4) = 17
.ColWidth(5) = 17
' กำหนดคุณสมบัติต่างๆของแต่ละหลักแบบ Run Time
.Col = 0
.TypeVAlign = TypeVAlignCenter
.TypeHAlign = TypeHAlignLeft
'//
.Col = 1
.Lock = True
.ColWidth(1) = 0
.UserResizeCol = UserResizeOff
.UserResizeRow = UserResizeOff
'
.Col = 2
.TypeTextWordWrap = True
.TypeVAlign = TypeVAlignCenter
.TypeHAlign = TypeHAlignRight
' กำหนดการป้อนค่าตัวเลขจำนวนเงินเท่านั้น
.CellType = CellTypeNumber
' ตามหลังจุศนิยม
.TypeNumberDecPlaces = 2
.TypeNumberMin = 0
' ไม่แสดงสัญลักษณ์ตัวเงิน
.TypeCurrencyShowSymbol = False
.Lock = False
.Col = 3
.TypeHAlign = TypeHAlignRight
.TypeVAlign = TypeVAlignCenter
.CellType = CellTypeNumber
.TypeNumberDecPlaces = 2
.TypeNumberMin = 0
.TypeCurrencyShowSymbol = False
.Lock = False
' หน่วยละ
.Col = 4
.TypeHAlign = TypeHAlignRight
.TypeVAlign = TypeVAlignCenter
.CellType = CellTypeNumber
.TypeNumberDecPlaces = 2
.TypeCurrencyShowSymbol = False
.TypeNumberShowSep = True
.Lock = False
' รวมจำนวนเงิน
.Col = 5
.TypeHAlign = TypeHAlignRight
.TypeVAlign = TypeVAlignCenter
.CellType = CellTypeNumber
.TypeNumberDecPlaces = 2
.TypeNumberShowSep = True
.TypeCurrencyShowSymbol = False
.Lock = True
End With
' Span Cell
fp.AddCellSpan 2, 9, 5, 9
fp.SetCellBorder 0, 1, -1, -1, 15, &H808080, CellBorderStyleSolid
End Sub
' /--------------------------------------------------------------------------------------------------------
' / ข้อมูลทดสอบ
Sub DemoData()
' /--------------------------------------------------------------------------------------------------------
' ใส่ข้อมูลทดสอบ
With fp
.Row = 1
.Col = 0: .Text = "ค่าห้องพัก"
.Col = 1: .Text = 1
.Col = 2: .Text = "0.00": .Lock = True: .BackColor = &HE0E0E0
.Col = 3: .Text = "0.00": .Lock = True: .BackColor = &HE0E0E0
.Col = 4: .Text = "2,800"
.Col = 5: .Formula = "D1": .BackColor = &HC0FFFF
.Row = 2
.Col = 0: .Text = "ค่าน้ำประปา"
.Col = 1: .Text = 2
.Col = 2: .Text = "286.00"
.Col = 3: .Text = "300.00"
.Col = 4: .Text = "20.00"
.Col = 5: .Formula = "(C2-B2) * D2": .BackColor = &HFFFFF0
.Row = 3
.Col = 0: .Text = "ค่าไฟฟ้า"
.Col = 1: .Text = 3
.Col = 2: .Text = "312.00"
.Col = 3: .Text = "333.00"
.Col = 4: .Text = "8.00"
.Col = 5: .Formula = "(C3-B3) * D3": .BackColor = &HC0FFFF
.Row = 4
.Col = 0: .Text = "ค่าอินเทอร์เน็ต"
.Col = 1: .Text = 4
.Col = 2: .Text = "0.00": .Lock = True: .BackColor = &HE0E0E0
.Col = 3: .Text = "0.00": .Lock = True: .BackColor = &HE0E0E0
.Col = 4: .Text = "100.00"
.Col = 5: .Formula = "D4": .BackColor = &HFFFFF0
.Row = 5
.Col = 0: .Text = "ค่าเคเบิ้ลทีวี"
.Col = 1: .Text = 5
.Col = 2: .Text = "0.00": .Lock = True: .BackColor = &HE0E0E0
.Col = 3: .Text = "0.00": .Lock = True: .BackColor = &HE0E0E0
.Col = 4: .Text = "0.00"
.Col = 5: .Formula = "D5": .BackColor = &HC0FFFF
'
.Row = 6
.Col = 0: .Text = "ค่าเก็บขยะ"
.Col = 1: .Text = 6
.Col = 2: .Text = "0.00": .Lock = True: .BackColor = &HE0E0E0
.Col = 3: .Text = "0.00": .Lock = True: .BackColor = &HE0E0E0
.Col = 4: .Text = "0.00"
.Col = 5: .Formula = "D6": .BackColor = &HFFFFF0
'
.Row = 7
.Col = 0: .Text = "ค่าปรับล่าช้า"
.Col = 1: .Text = 7
.Col = 2: .Text = "0.00": .Lock = True: .BackColor = &HE0E0E0
.Col = 3: .Text = "0.00": .Lock = True: .BackColor = &HE0E0E0
.Col = 4: .Text = "0.00"
.Col = 5: .Formula = "D7": .BackColor = &HC0FFFF
'
.Row = 8
.Col = 0: .Text = "อื่นๆ"
.Col = 1: .Text = 8
.Col = 2: .Text = "0.00": .Lock = True: .BackColor = &HE0E0E0
.Col = 3: .Text = "0.00": .Lock = True: .BackColor = &HE0E0E0
.Col = 4: .Text = "-0.00"
.Col = 5: .Formula = "D8": .BackColor = &HFFFFF0
' COLUMN E
.Row = 9
.Col = 0: .Text = "รวมจำนวนเงินทั้งสิ้น"
.Col = 1: .Text = 9
.Col = 2: .Formula = "SUM(E1:E8)"
.BackColor = &HFFEFEF
.Lock = True
.FontBold = True
.ForeColor = vbBlue
.RowHeight(9) = 24
.TypeNumberDecPlaces = 2
.TypeNumberShowSep = True
.TypeHAlign = TypeHAlignRight
.TypeVAlign = TypeVAlignCenter
End With
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.Height < 11475 Then
Me.Height = 11475
Exit Sub
End If
'
If Me.Width < 11550 Then '9950 Then
Me.Width = 11550
Exit Sub
End If
'//
cmdExit.Left = Me.ScaleWidth - cmdExit.Width - 75
cmdPrint.Left = cmdExit.Left - cmdExit.Width - 60
fraFP.Move 15, 870
fraFP.Width = Me.ScaleWidth - 30
fraFP.Height = fp.Top - fraPrint.Top
fp.Width = fraFP.Width - 75
'//
fraPrint.Width = Me.ScaleWidth - 15
fraPrint.Height = Me.ScaleHeight - fraFP.Height - fraFP.Top
ARViewerSlip.Move 15, 120, fraPrint.Width - 60, fraPrint.Height - 180
End Sub
Private Sub Form_Unload(Cancel As Integer)
'// ลบไฟล์ขยะ (Temporary) ก่อนปิดโปรแกรม
If Dir$(App.Path & "\*.tmp") <> "" Then Kill App.Path & "\*.tmp"
Set frmFPG = Nothing
End
End Sub
' / --------------------------------------------------------------------------------
'// ก่อนทำการแก้ไข
Private Sub fp_BeforeEditMode(ByVal Col As Long, ByVal Row As Long, ByVal UserAction As FPUSpreadADO.BeforeEditModeActionConstants, CursorPos As Variant, Cancel As Variant)
' / ค่าที่สำคัญคือ Col, Row
' / รับค่าหลัก, แถว
fp.Col = Col: fp.Row = Row
'// เก็บค่าเดิมของหลัก 2 และหลัก 3 เอาไว้เปรียบเทียบมากกว่า/น้อยกว่า
Select Case Col
Case 2
strCell1 = CDbl(fp.Value)
'// เพิ่มหลักไปรับค่าเดิมในหลัก 3
fp.Col = Col + 1
strCell2 = CDbl(fp.Value)
Case 3
'// ถอยหลักกลับไปรับค่าเดิมในหลัก 2
fp.Col = Col - 1
strCell1 = CDbl(fp.Value)
fp.Col = Col
strCell2 = CDbl(fp.Value)
End Select
End Sub
' / --------------------------------------------------------------------------------
'// เมื่อแก้ไขข้อมูลในเซลล์แล้วกด Enter ต้องทำการทดสอบค่าเริ่มต้นและค่าสิ้นสุด
Private Sub fp_EditMode(ByVal Col As Long, ByVal Row As Long, ByVal Mode As Integer, ByVal ChangeMade As Boolean)
fp.Col = Col: fp.Row = Row
' ดักจับค่าว่างก่อน หากไม่มีก็ออกจากโปรแกรมย่อยไป
If IsNull(fp.Value) Or Trim(fp.Value) = "" Then Exit Sub
' Mode 0 คือ Edit Mode
Select Case Mode
Case 0:
Select Case Col
'// หลัก 2 จะมากกว่าหลัก 3 ไม่ได้ หากใช่ให้แจ้งเตือนพร้อมกับคืนค่าเดิม
Case 2:
If CDbl(fp.Value) > CDbl(strCell2) Then
MsgBox "อย่ามากกว่าหน่วยสุดท้ายซิ เดี๋ยวโดนตบจูบซ่ะหรอก", vbOKOnly + vbInformation, "รายงานความผิดพลาด"
fp.Value = CDbl(strCell1)
End If
Case 3:
'// หลัก 3 จะน้อยกว่าหลัก 2 ไม่ได้ หากใช่ให้แจ้งเตือนพร้อมกับคืนค่าเดิม
If CDbl(fp.Value) < CDbl(strCell1) Then
MsgBox "อย่าน้อยว่าหน่วยเริ่มต้นซิ เดี๋ยวโดนตบจูบซ่ะหรอก", vbOKOnly + vbInformation, "รายงานความผิดพลาด"
fp.Value = CDbl(strCell2)
End If
End Select
End Select
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub mnuFileExit_Click()
Unload Me
End Sub
Private Sub mnuFileSetup_Click()
frmSetup.Show vbModal
End Sub
โค้ดในส่วนของการพิมพ์รายงานด้วย ActiveReports 2.0
' / --------------------------------------------------------------------------------
' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
' / eMail : thongkorn@hotmail.com
' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
' / Facebook: https://www.facebook.com/g2gnet (For Thailand)
' / Facebook: https://www.facebook.com/commonindy (Worldwide)
' / Purpose: Print bill on paper size A5.
' / Microsoft Visual Basic 6.0 (SP1) + FarPoint Spread 8.0
' /
' / This is open source code under @CopyLeft by Thongkorn Tubtimkrob.
' / You can modify and/or distribute without to inform the developer.
' / --------------------------------------------------------------------------------
Option Explicit
Dim ItemNo As Integer
Dim GrandTotal As Double
' / --------------------------------------------------------------------------------
' / ส่วนการอ่านข้อมูลเข้ามาพิมพ์ ด้วยการนับจำนวนแถวใน FarPoint Spread
Private Sub ActiveReport_FetchData(EOF As Boolean)
ItemNo = ItemNo + 1
' ตรวจสอบจำนวนการพิมพ์ทั้งหมด อ้างถึง frmFPG.fp.DataRowCnt - 1
If ItemNo > frmFPG.fp.DataRowCnt - 1 Then
EOF = True
Exit Sub
Else
EOF = False
End If
End Sub
' / --------------------------------------------------------------------------------
' / ส่วนเริ่มต้นการพิมพ์ทุกครั้ง
Private Sub ActiveReport_Initialize()
PageSettings.Orientation = ddOPortrait
'// ตั้งค่ากระดาษเอง
PageSettings.PaperSize = 256
'// หน่วยวัดเป็น Twip (1440 Twip = 1 Inch = 2.54 Cm.)
PageSettings.LeftMargin = 500
PageSettings.RightMargin = 60
PageSettings.BottomMargin = 100
PageSettings.TopMargin = 600
' ขนาดครึ่ง A4 และ ทำการแปลงหน่วยวัดเป็นเซนติเมตร เพื่อให้ง่ายในการวัดระยะ (1440 Twip = 1 Inch = 2.54 Cm.)
PageSettings.PaperHeight = (14.5 * 1440 / 2.54)
PageSettings.PaperWidth = (21 * 1440 / 2.54)
'
txtCname.Text = ""
txtRoomNo.Text = ""
txtDate.Text = ""
txtDateMonth.Text = ""
txtItem.Text = ""
txtDesc.Text = ""
txtQTY.Text = ""
txtUnitPrice.Text = ""
txtAmount.Text = ""
txtGrandTotal.Text = 0
'
lblRemark1.Caption = ""
lblRemark2.Caption = ""
'// อ่านค่า INI File
Dim strFileINI As String
strFileINI = App.Path & "\Config.ini"
'// เช็คว่ามีไฟล์ Config.ini อยู่หรือไม่???
'// หากไม่มีก็ตั้งค่าเริ่มต้นให้ก่อน
If Dir(strFileINI) = "" Then
WriteIniValue strFileINI, "Config", "Owner", "ทองก้อน ฮาเร็ม อพาร์ทเมนท์ 2017"
WriteIniValue strFileINI, "Config", "Address", "123/456 ถ.กลางเมือง ต.เมืองเก่า อ.เมือง จ.ขอนแก่น โทร.043-XXX-XXX"
WriteIniValue strFileINI, "Config", "Remark1", "1. กรุณาชำระเงินภายในวันที่ 32 ของทุกเดือน"
WriteIniValue strFileINI, "Config", "Remark2", "2. การเงินมีปัญหา ใส่ชุดนักศึกษามาหาป๋าทองก้อนได้ตลอด 24 ชั่วโมง"
End If
'// อ่านค่า Config ต่างๆเข้ามา
txtOwner.Text = ReadIniValue(strFileINI, "Config", "Owner")
txtAddress.Text = ReadIniValue(strFileINI, "Config", "Address")
lblRemark1.Caption = ReadIniValue(strFileINI, "Config", "Remark1")
lblRemark2.Caption = ReadIniValue(strFileINI, "Config", "Remark2")
End Sub
' / --------------------------------------------------------------------------------
' / ส่วนของการพิมพ์รายละเอียดแต่ละแถว
Private Sub Detail_Format()
' ตัวแปร ItemNo กลายเป็นแบบ Static
txtItem.Text = ItemNo & "."
' Description หลัก 0
frmFPG.fp.Col = 0: frmFPG.fp.Row = ItemNo
txtDesc.Text = frmFPG.fp.Text
' จำนวนหน่วยหลัก 2 และ 3
Dim MeterStart As Double: Dim MeterEnd As Double: Dim Meter As Double
frmFPG.fp.Col = 2
MeterStart = frmFPG.fp.Text
frmFPG.fp.Col = 3
MeterEnd = frmFPG.fp.Text
Meter = MeterEnd - MeterStart
' ค่าน้ำประปา
If ItemNo = 2 Or ItemNo = 3 Then
txtDesc.Text = txtDesc.Text & " (" & MeterEnd & " - " & MeterStart & " = " & Meter & " หน่วย)"
End If
frmFPG.fp.Col = 4
If frmFPG.fp.Value <> 0 And (MeterStart = 0) And (MeterEnd = 0) Then
txtQTY.Text = "1.00"
Else
txtQTY.Text = Format(Meter, "#,##0.00")
End If
' ราคาต่อหน่วย
frmFPG.fp.Col = 4
txtUnitPrice.Text = Format(frmFPG.fp.Text, "#,##0.00")
' รวมเงิน
frmFPG.fp.Col = 5
txtAmount.Text = Format(frmFPG.fp.Text, "#,##0.00")
' หาจำนวนเงินรวม
GrandTotal = Format(GrandTotal + CDbl(txtAmount.Text), "#,##0.00")
'
'// กระโดดไป FetchData เข้ามาใหม่ จนกว่าข้อมูลรายการจำนวนแถวจะนับได้ครบ ถือเป็นการสิ้นสุดการพิมพ์
End Sub
Private Sub GroupFooter1_Format()
txtGrandTotal.Text = "รวมจำนวนเงินทั้งสิ้น: " & Format(GrandTotal, "#,##0.00") & ""
End Sub
Private Sub GroupHeader1_Format()
'// อ้างอิงถึงค่าจาก TextBox ในฟอร์ม frmFPG
txtCname.Text = frmFPG.txtFirstName & " " & frmFPG.txtLastName
txtRoomNo.Text = frmFPG.txtRoomNo.Text
txtDate.Text = Format(Now(), "dd/mm/yyyy") & " เวลา: " & Format(Now(), "HH:MM")
txtDateMonth.Text = frmFPG.txtMonth.Text
End Sub
Private Sub ActiveReport_ReportEnd()
Set arSlipA5 = Nothing
Unload Me
End Sub
ดาวน์โหลดโค้ดต้นฉบับ VB6 ได้ที่นี่ ...
ขอบคุณครับท่านอาจารย์ ขอบคุณมากคะ
หน้า:
[1]