[VB6] แจกฟรีโค้ดการพิมพ์ใบเสร็จรับเงินด้วย VB6 + FarPoint ออกทาง MS Excel

thongkorn

บทความนี้แอดมินได้เขียนแจกโค้ดไปตั้งแต่ปี 2555 วันนี้เอามารีรันใหม่ เป็นการทำใบเสร็จรับเงิน ด้วยการใช้ VB6 เป็นส่วนของการรับอินพุทข้อมูล ทำการกรอกข้อมูลรายละเอียดสินค้าเข้าไปในตารางกริดของ FarPoint Spread ที่มีลักษณะเหมือน Excel จากนั้นส่งข้อมูลต่างๆออกไปยัง MS Excel โดยการคัดลอกรูปแบบ Sheet ต้นฉบับ แล้วทำการสร้างชีตขึ้นมาใหม่ แล้วก็นำเอาข้อมูลต่างๆที่อยู่บนฟอร์มของ VB6 ไปใส่ไว้ในตารางของ Excel ในช่องที่เรากำหนดไว้ล่วงหน้า ... การทำแบบนี้เราจึงไม่ต้องพึ่งพวก Component ในการทำรายงานเลย ...
ดาวน์โหลด FarPoint Spread ActiveX จากผู้ผลิต ...
ดาวน์โหลด FarPoint Spread ActiveX ... (เฉพาะสมาชิกเท่านั้น)

การเลือก FarPoint Spread ActiveX

Project --> Components ...

มาดูโค้ดกันเถอะ ...

1. ' / --------------------------------------------------------------------------------
   
2. ' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
   
3. ' / eMail : thongkorn@hotmail.com
   
4. ' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
   
5. ' / Facebook: https://www.facebook.com/g2gnet (For Thailand)
   
6. ' / Facebook: https://www.facebook.com/commonindy (Worldwide)
   
7. ' / MORE: http://www.g2gnet.com/webboard
   
8. ' /
   
9. ' / Purpose: Print receipt via Excel with VB6.
   
10. ' / Microsoft Visual Basic 6.0 (SP6)
    
11. ' /
    
12. ' / This is open source code under @CopyLeft by Thongkorn Tubtimkrob.
    
13. ' / You can modify and/or distribute without to inform the developer.
    
14. ' / --------------------------------------------------------------------------------
    
15. 
    
16. Option Explicit
    
17. 
    
18. ' / --------------------------------------------------------------------------------
    
19. ' / โปรแกรมย่อยที่กำหนดค่าคุณสมบัติ (Properties) ต่างๆ ให้กับ Spread
    
20. Sub SetupSpread()
    
21. ' / --------------------------------------------------------------------------------
    
22.     ' แสดงแถบแสงหรือไม่แสดง
    
23.     FpSpread1.OperationMode = OperationModeNormal   ' เอาไว้ป้อนข้อมูล
    
24.     'fpSpread1.OperationMode = OperationModeSingle    ' แถบ Selection
    
25.     'fpSpread.OperationMode = OperationModeRead     ' ไม่มีแถบ
    
26.     'fpSpread.OperationMode = OperationModeRow
    
27.    
    
28.     ' สามารถจัดเรียง หรือ Sort Order บนหัวคอลัมภ์ได้
    
29.     FpSpread1.UserColAction = UserColActionSort
    
30.    
    
31.     ' ปรับหน่วยวัด
    
32.     'fpSpread1.UnitType = UnitTypeNormal
    
33.     'fpSpread1.UnitType = UnitTypeTwips
    
34.     'FpSpread1.UnitType = UnitTypeVGABase
    
35.    
    
36.     ' การปรับความสูงของแถวทุกๆแถว (ค่า -1 หมายถึงทุกแถวครับ)
    
37.     FpSpread1.RowHeight(-1) = 18    ' หน่วยวัด Point
    
38.     FpSpread1.Appearance = Appearance3D
    
39.    
    
40.     ' เวลากด F2 เพื่อแก้ไขข้อมูลในแต่ละเซลล ์ให้เลือกข้อมูลทั้งหมด หรือสามารถเริ่มคีย์ค่าใหม่ได้ทันที
    
41.     FpSpread1.EditModeReplace = True
    
42.    
    
43.     ' ส่วนตัวอื่นๆ
    
44.     With FpSpread1
    
45.         ' หลักแรก คือ หลักที่ 0 ... จะเป็นการแสดงหมายเลขแถว เพื่ออ้างอิงในลักษณะ Excel เช่น
    
46.         .SetText 1, 0, "PK"
    
47.         .SetText 2, 0, "รหัสสินค้า"
    
48.         .SetText 3, 0, "รายละเอียด"
    
49.         .SetText 4, 0, "หน่วยละ"
    
50.         .SetText 5, 0, "จำนวน"
    
51.         .SetText 6, 0, "รวมจำนวนเงิน"
    
52.         
    
53.         ' จำนวนหลักทั้งหมด
    
54.         .MaxCols = 6
    
55.         ' จำนวนแถวสูงสุด 17 แถว (ผมนับจากใน MS Excel)
    
56.         .MaxRows = 17
    
57.         
    
58.         ' อย่าลืมเอา Primary Key ไปซ่อนไว้ไม่ให้ผู้ใช้งานเห็นด้วย ... ผู้ใช้งานจะได้ไม่สับสน
    
59.         .ColWidth(1) = 0
    
60.         ' จัดระยะความกว้างเอง หน่วยนับเหมือนใน .NET
    
61.         '.ColWidth(2) = 15
    
62.         '.ColWidth(3) = 15
    
63.         '.ColWidth(4) = 15
    
64.         '.ColWidth(5) = 12
    
65.         '.ColWidth(6) = 15
    
66.         
    
67.         ' กำหนดคุณสมบัติต่างๆของแต่ละหลักแบบ Run Time
    
68.         .Col = 2
    
69.         .TypeTextWordWrap = True
    
70.         .TypeVAlign = TypeVAlignCenter
    
71.         .Col = 3
    
72.         .TypeTextWordWrap = True
    
73.         .TypeVAlign = TypeVAlignCenter
    
74.         
    
75.         .Col = 4
    
76.         ' การจัดตำแหน่งแนวนอน
    
77.         .TypeHAlign = TypeHAlignRight
    
78.         ' การจัดตำแหน่งแนวตั้ง
    
79.         .TypeVAlign = TypeVAlignCenter
    
80.         ' กำหนดการป้อนค่าตัวเลขจำนวนเงินเท่านั้น
    
81.         .CellType = CellTypeCurrency
    
82.         ' ตามหลังจุศนิยม
    
83.         .TypeNumberDecPlaces = 2
    
84.         ' ไม้แสดงสัญลักษณ์ตัวเงิน
    
85.         .TypeCurrencyShowSymbol = False
    
86.         
    
87.         .Col = 5
    
88.         ' การจัดตำแหน่ง
    
89.         .TypeHAlign = TypeHAlignRight
    
90.         .TypeVAlign = TypeVAlignCenter
    
91.         .CellType = CellTypeNumber
    
92.         .TypeNumberDecPlaces = 0
    
93.         .TypeCurrencyShowSymbol = False
    
94.         
    
95.         .Col = 6
    
96.         ' ล็อคการคีย์ข้อมูล
    
97.         .Lock = True
    
98.         .TypeHAlign = TypeHAlignRight
    
99.         .TypeVAlign = TypeVAlignCenter
    
100.         .CellType = CellTypeCurrency
     
101.         .TypeCurrencyShowSymbol = False
     
102.         ' จุดทศนิยม 2 ตัว
     
103.         .TypeNumberDecPlaces = 2
     
104.         ' แสดงเครื่องหมายคอมม่า (,)
     
105.         .TypeCurrencyShowSep = True
     
106.    
     
107.     End With
     
108.    
     
109. End Sub
     
110. 
     
111. ' / --------------------------------------------------------------------------------
     
112. ' / โปรแกรมย่อยเคลียร์ค่าต่างๆในฟอร์มใหม่
     
113. Sub SetupScreen()
     
114. ' / --------------------------------------------------------------------------------
     
115.     txtInvoiceNumber.Text = ""
     
116.     txtCustomerName.Text = ""
     
117.     txtAddress.Text = ""
     
118.     txtAmphur.Text = ""
     
119.     txtProvinceName.Text = ""
     
120.     txtPostCode.Text = ""
     
121.     txtTelephone.Text = ""
     
122.     txtFacsimile.Text = ""
     
123.     txtTotalAmount.Text = "0.00"
     
124.     txtInvBook.Text = ""
     
125.     txtInvNumber.Text = ""
     
126.    
     
127.     ' หรือเคลียร์ค่าใน TextBox Control แบบ Dynamic
     
128.     'Dim Ctl As Control
     
129.     'For Each Ctl In Me.Controls
     
130.     '    If TypeOf Ctl Is TextBox Then Ctl.Text = ""
     
131.     'Next
     
132.    
     
133. End Sub
     
134. 
     
135. ' / --------------------------------------------------------------------------------
     
136. ' / ข้อมูลทดสอบ เพราะขี้เกียจพิมพ์ใหม่ทุกครั้ง 55555+
     
137. Sub DemoData()
     
138. ' / --------------------------------------------------------------------------------
     
139.     'FpSpread1.ActiveSheet
     
140.     ' ใส่ข้อมูลทดสอบ
     
141.     With FpSpread1
     
142.             .Row = 1
     
143.             '.ActiveSheet.Cells(1, 1) = 1
     
144.             '.ActiveSheet.Cells(1, 2) = "8851234567890"
     
145.             .Col = 1: .Text = 1
     
146.             .Col = 2: .Text = "8851234567890"
     
147.             .Col = 3: .Text = "คู่มือการเมาอย่างถูกต้อง"
     
148.             .Col = 4: .Text = "599.00"
     
149.             .Col = 5: .Text = "10"
     
150.             .Col = 6: .Text = "5990.00"
     
151.             .Row = 2
     
152.             .Col = 1: .Text = 2
     
153.             .Col = 2: .Text = "8850987654321"
     
154.             .Col = 3: .Text = "CD หนัง X เพื่อการศึกษา"
     
155.             .Col = 4: .Text = "999.00"
     
156.             .Col = 5: .Text = "10"
     
157.             .Col = 6: .Text = "9990.00"
     
158.             .Row = 3
     
159.             .Col = 1: .Text = 3
     
160.             .Col = 2: .Text = "8850123456789"
     
161.             .Col = 3: .Text = "หนังสือดี"
     
162.             .Col = 4: .Text = "100.00"
     
163.             .Col = 5: .Text = "20"
     
164.             .Col = 6: .Text = "2000.00"
     
165.     End With
     
166.    
     
167. End Sub
     
168. 
     
169. ' / --------------------------------------------------------------------------------
     
170. ' / โปรแกรมย่อยเพื่อเคลียร์ค่าต่างๆใหม่หมด
     
171. Private Sub cmdClear_Click()
     
172. ' / --------------------------------------------------------------------------------
     
173.     ' เคลียร์ข้อมูลใน TextBox Control ทั้งหมด
     
174.     Call SetupScreen
     
175.     ' ลบแถวออกทั้งหมดเริ่มจากแถวที่ 1 ถึง 17
     
176.     FpSpread1.DeleteRows 1, 17
     
177. 
     
178. End Sub
     
179. 
     
180. Private Sub cmdExit_Click()
     
181.     Unload Me
     
182. End Sub
     
183. 
     
184. ' / --------------------------------------------------------------------------------
     
185. ' / โปรแกรมย่อยในการส่งข้อมูลทั้งในตาราง FarPoint หรือบนฟอร์มไปให้กับ MS Excel
     
186. Private Sub cmdPrint2Excel_Click()
     
187. ' / --------------------------------------------------------------------------------
     
188.     On Error GoTo ErrorHandler
     
189.    
     
190.     ' ประกาศตัวแปรใช้งาน Excel Object (Application)
     
191.     Dim ExcelApp  As New Excel.Application
     
192.    
     
193.     ' ประกาศตัวแปรใช้งาน WorkSheet ของ ExcelApp Object
     
194.     Dim ExcelSheet As New Excel.Worksheet
     
195.    
     
196.     ' ประกาศตัวแปรใช้งาน WorkBook ของ ExcelApp Object
     
197.     Dim ExcelBook As New Excel.Workbook
     
198. 
     
199.     ' สร้าง Excel Object ขึ้นมาใช้งาน ในชื่อ ExcelApp
     
200.     Set ExcelApp = CreateObject("Excel.Application")
     
201.     'Set ExcelApp = New Excel.Application
     
202. 
     
203.     ' เปิด WorkBook เดิม ก็ใช้ Open Method ตามด้วยไฟล์ที่ต้องการเอาครับ
     
204.     Set ExcelBook = ExcelApp.Workbooks.Open(App.Path & "\ReceiptG2GNet.xls")
     
205.     ' / --------------------------------------------------------------------------------
     
206.     ' การคัดลอก Sheet ต้นแบบ (Sheet1) ไปยัง Sheet ตัวใหม่ก่อน ... มันจะตั้งค่าสำเนาให้อัตโนมัติ
     
207.     ' เช่น Sheet(1), Sheet(2) ... มันมาจากการกำหนดค่าด้วย ExcelBook.Worksheets.Count
     
208.     ' ซึ่งมันจะไปต่อท้าย Sheet ล่าสุดที่มีอยู่ เพราะเราสั่งด้วย After (หากอยากให้ไปอยู่ข้างหน้า ก็ใช้ Before แทน)
     
209.     ' การสั่งแบบนี้หมายถึงให้คัดลอกทั้ง Sheet ไม่ว่าจะเป็นข้อมูล กล่องข้อความ ภาพ Shape และอื่นๆ ... มันก็จะไปหมดเลย
     
210.     ExcelBook.Worksheets(1).Copy After:=ExcelBook.Worksheets(ExcelBook.Worksheets.Count)
     
211.     ' หรืออ้างถึงชื่อ Sheet โดยตรงก็ได้ ... แต่ต้องอ้างถึงชื่อ Sheet ให้ถูกล่ะกันครับ
     
212.     ' ExcelBook.Worksheets("Sheet1").Copy After:=ExcelBook.Worksheets(ExcelBook.Worksheets.Count)
     
213.     ' / --------------------------------------------------------------------------------
     
214.    
     
215.     ' หรือ หากต้องการเปลี่ยนชื่อ Sheet เช่น เอาวันที่ + เวลา มาผสมกัน ... ก็ทำได้โดยใช้ Name Method
     
216.     ' Sheets(ExcelBook.Worksheets.Count).Name = Format(Now(), "ddmmyyyy") & _
     
217.                 "-" & Format(Now(), "hhmmss")
     
218.    
     
219.     ' กำหนดให้ใช้งาน Sheet ปัจจุบัน (ไม่ใช้งานก็ได้ มันไปที่ Sheet ใหม่อยู่แล้วครับ)
     
220.     Set ExcelSheet = ExcelApp.Workbooks.Application.ActiveSheet
     
221. 
     
222.     Dim fpRow As Integer   ' เริ่มต้นการอ่านข้อมูลแถวแรกในตารางกริด
     
223.     Dim xlsRow As Integer    ' เริ่มต้นแถวแรกที่เก็บข้อมูลใน MS Excel
     
224. 
     
225.     ' กำหนดตำแหน่งส่งข้อมูลไป Excel โดยจะเริ่มต้นรับข้อมูลจากแถวที่ 13 และ หลักที่ 1 (A13)
     
226.     ' คือเราสามารถอ้างอิงถึงได้ทั้งแถว หลัก หรือ Cell ตำแหน่งนั้นๆเลย หรือ จะใช้ Range แทนก็ได้
     
227.     ' แถว/หลักแรกที่กำหนด อันนี้ก็ต้องขึ้นอยู่กับรูปแบบฟอร์มที่เราออกแบบเองด้วยน่ะขอรับ ...
     
228.     xlsRow = 13
     
229.    
     
230.     ' เริ่มต้นแถวที่ 1 ไปตามจำนวนแถวทั้งหมดของ FarPoint
     
231.     For fpRow = 1 To FpSpread1.MaxRows
     
232.          With FpSpread1
     
233.             
     
234.             ' รหัสสินค้า (ใส่เครื่องหมาย Single Quote เพื่อป้องกันรหัสสินค้าที่นำหน้าด้วย 0)
     
235.             .Col = 2: .Row = fpRow
     
236.             ExcelApp.Cells(xlsRow, 1) = CStr("'" & .Text)
     
237.             
     
238.             ' ชื่อสินค้า
     
239.             .Col = 3
     
240.             ExcelApp.Cells(xlsRow, 2) = "" & .Text
     
241.             
     
242.             ' การจัดรูปแบบการแสดงผลตัวเลข เช่น 1,250.00 ผมจัดเอาไว้อยู่ใน Excel เองน่ะครับ
     
243.             ' ราคาต่อหน่วย
     
244.             .Col = 4
     
245.             ExcelApp.Cells(xlsRow, 3) = "" & .Text
     
246.             ' จำนวน
     
247.             .Col = 5
     
248.             ExcelApp.Cells(xlsRow, 4) = "" & .Text
     
249.             ' รวมจำนวนเงิน
     
250.             .Col = 6
     
251.             ExcelApp.Cells(xlsRow, 5) = "" & .Text
     
252.             
     
253.             ' เพิ่มจำนวนแถวใน Excel ขึ้นอีก 1
     
254.             xlsRow = xlsRow + 1
     
255.             ' เทคนิค ... ความเป็นจริงเราสามารถลดการใช้งานตัวแปร xlsRow ออกไปก็ได้
     
256.             ' เรารู้ว่า fpRow เริ่มต้นที่ 1 ... เรารู้ว่าใน Excel ต้องเริ่มต้นรับข้อมูลในแถวที่ 13 (ต่างกัน 12)
     
257.             ' ดังนั้นปลด xlsRow ออกไป แล้วให้ใช้ fpRow + 12 แทนยังไงล่ะครับ ... พี่น้อง ม่วนหลายๆ
     
258.             ' แต่ที่ผมทำตัวอย่างออกมาก็เพื่อไม่อยากให้มือใหม่ๆได้งง จะได้อ่านโค้ดง่ายขึ้นครับ
     
259.         End With
     
260.     Next
     
261.    
     
262.     ' นำรายละเอียดต่างๆไปแสดงผลใน Excel คือชื่อลูกค้า (แถวที่ 6 หลักที่ 1 หรือเซลล์ A6)
     
263.     ExcelApp.Cells(6, 1) = "" & "ชื่อลูกค้า: " & Trim(txtCustomerName.Text)
     
264.    
     
265.     ' ที่อยู่ลูกค้า แถวที่ 7 หลักที่ 1 หรือเซลล์ A7
     
266.     ExcelApp.Cells(7, 1) = "" & "ที่อยู่: " & Trim(txtAddress.Text) & vbCrLf & _
     
267.                 Trim$(txtAmphur.Text) & "  " & Trim$(txtProvinceName.Text) & "  " & _
     
268.                 Trim$(txtPostCode.Text) & vbCrLf & _
     
269.                 "โทร. " & Trim$(txtTelephone.Text)
     
270.     ' วันที่ แสดงผลแถวที่ 6 หลักที่ 3 หรือเซลล์ C6
     
271.     ExcelApp.Cells(6, 3) = "วันที่ " & Format(Now(), "dd/mm/yyyy")
     
272.    
     
273.     ' ใบเสร็จเลขที่/เล่มที่/เลขที่
     
274.     If Trim(txtInvoiceNumber.Text) <> "" Or Len(Trim$(txtInvoiceNumber.Text)) <> 0 Then _
     
275.         ExcelApp.Cells(1, 4) = "ใบเสร็จเลขที่ " & Trim(txtInvoiceNumber.Text)
     
276.     If Trim(txtInvBook.Text) <> "" Or Len(Trim$(txtInvBook.Text)) <> 0 Then _
     
277.         ExcelApp.Cells(2, 4) = "เล่มที่ " & Trim(txtInvBook.Text)
     
278.     If Trim(txtInvNumber.Text) <> "" Or Len(Trim$(txtInvNumber.Text)) <> 0 Then _
     
279.         ExcelApp.Cells(3, 4) = "เล่มที่ " & Trim(txtInvNumber.Text)
     
280.    
     
281.     ' แสดงผลโปรแกรม Excel ขึ้นมาให้ User มองเห็น
     
282.     ExcelApp.Visible = True
     
283.     ' บันทึกข้อมูลทับไฟล์เดิมแบบอัติโนมัติทันที แต่เพิ่ม Sheet ใหม่
     
284.     ExcelBook.Save
     
285.    
     
286.     ' / --------------------------------------------------------------------------------
     
287.     ' / การบันทึกไฟล์มีหลาย Option มากมายให้เลือก คงต้องไปลองศึกษาเพิ่มเติมกันเองน่ะครับ
     
288.     ' / --------------------------------------------------------------------------------
     
289.    
     
290.     ' / --------------------------------------------------------------------------------
     
291.     ' กรณีที่ต้องการบันทึกไฟล์ใหม่ เราจะบังคับตั้งชื่อไฟล์ให้เอง
     
292.     'Dim FileXLS1 As String
     
293.     'FileXLS1 = "\Receipt" & Format(Date, "ddmmyyyy") & "-" & Format(Time, "hhmmss") & ".xls"
     
294.     ' บันทึกชื่อไฟล์ใหม่ เป็นชื่อไฟล์วันที่เวลา เช่น Receipt03042555-123015
     
295.     'ExcelBook.SaveAs (App.Path & FileXLS1)
     
296.     'ExcelBook.Close False, (App.Path & FileXLS1)
     
297.     ' / --------------------------------------------------------------------------------
     
298.    
     
299.     ' / --------------------------------------------------------------------------------
     
300.     ' กรณีที่ต้องการบันทึกไฟล์ใหม่ แต่เลือกบันทึกชื่อไฟล์ใหม่ได้
     
301.     'Dim FileXLS2 As Variant
     
302.     'FileXLS2 = ExcelApp.Application.GetSaveAsFilename( _
     
303.         FileFilter:="Excel Files, *.xls, All Files, *.*", _
     
304.         Title:="[Save As - บันทึกชื่อไฟล์ใหม่")
     
305.     ' หากมีการกดปุ่ม Cancel เพื่อยกเลิก
     
306.     'If FileXLS2 = False Then Exit Sub
     
307.    
     
308.     'If LCase$(Right$(FileXLS2, 4)) <> ".xls" Then FileXLS2 = FileXLS2 & ".xls"
     
309.    
     
310.     ' บันทึกไฟล์ในชื่อใหม่
     
311.     'ExcelApp.ActiveWorkbook.SaveAs FileName:=FileXLS2
     
312.     ' หาก Save ไฟล์ใหม่แบบนี้ ควรปิดการแสดงผลของ Excel ก่อน นั่นคือจากบรรทัดด้านบน
     
313.     ' ควรกำหนดให้ ExcelApp.Visible = Fale เพื่อไม่ให้ Excel แสดงขึ้นมา
     
314.     ' หรือลงไปบรรทัดข้างล่างกำหนดให้ปิด Excel คือ Excel.Application.Quit ออกไปเลย
     
315.     ' / --------------------------------------------------------------------------------
     
316. 
     
317.     ' ล้างให้ออก ... จาก Memory ของฉัน ... 55555+
     
318.     Set ExcelSheet = Nothing:    Set ExcelBook = Nothing
     
319.     ' หรือต้องการปิดโปรแกรม Excel ไปเลย
     
320.     'ExcelApp.Application.Quit
     
321.    
     
322.     Set ExcelApp = Nothing
     
323.    
     
324. ExitProc:
     
325.     ' แม้ว่าจะสั่งปิดโปรแกรม Excel ออกไปแล้วแต่มันยังค้างอยู่ (ไปดูที่ Process น่ะครับ)
     
326.     ' ดังนั้นสั่งผ่าน Shell เพื่อ Kill Process ของ Excel ก่อน (/F = Force คือบังคับมันเลย)
     
327.     'Shell "TaskKill /F /IM Excel.exe"
     
328.     Exit Sub
     
329.    
     
330. ErrorHandler:
     
331.    
     
332.     ' ขณะโปรแกรมกำลังทำงาน (Run Time) ดัก Error จาก On Error GoTo ErrorHandler
     
333.     Select Case Err.Number
     
334.         Case 462:
     
335.             MsgBox "กรุณาจบการทำงานของโปรแกรมก่อนที่จะบันทึกไฟล์ Excel อีกครั้ง", _
     
336.                 vbOKOnly + vbExclamation, "รายงานความผิดพลาด"
     
337.         Case Else
     
338.             MsgBox "ความผิดพลาด: " & vbCrLf & Err.Number & vbCrLf & Err.Description
     
339.     End Select
     
340.     ' ปกติให้ออกจากโปรแกรมจากจุดนี้ได้เลย แต่ที่ให้กระโดดกลับไปก็เพราะเผื่อมีงานอื่นที่ต้องทำก่อนจบการทำงาน
     
341.     Resume ExitProc
     
342. 
     
343. End Sub
     
344. 
     
345. ' / --------------------------------------------------------------------------------
     
346. ' / จะใช้งานการกด KeyDown เช่นพวกปุ่มฟังค์ชั่นต่างๆได้
     
347. ' / จะต้องกำหนดให้คุณสมบัติของฟอร์ม KeyPreview = True ก่อนด้วย
     
348. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
     
349. ' / --------------------------------------------------------------------------------
     
350.     Select Case KeyCode
     
351.         
     
352.         Case vbKeyF1: 'MsgBox "No help now."
     
353.         Case vbKeyF6: Call cmdPrint2Excel_Click
     
354.         Case vbKeyF10: Unload Me
     
355.    
     
356.    End Select
     
357. End Sub
     
358. 
     
359. ' / --------------------------------------------------------------------------------
     
360. ' / เริ่มต้นการทำงาน
     
361. Private Sub Form_Load()
     
362. ' / --------------------------------------------------------------------------------
     
363.     ' ป้องกันการเรียกใช้โปรแกรมซ้อนกัน
     
364.     If App.PrevInstance Then End
     
365.    
     
366.     ' จัดฟอร์มอยู่กึ่งกลางหน้าจอ
     
367.     Me.Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
     
368.    
     
369.     Call SetupScreen
     
370.     ' หรือกำหนดค่าทดสอบเอง (ขี้เกียจพิมพ์ตอนสั่งรัน 5555+)
     
371.     txtInvoiceNumber.Text = "INV55-000001"
     
372.     txtCustomerName.Text = "บุญห่อ พ่อรวย"
     
373.     txtAddress.Text = "999 ม.1 ซอย 39 ถ.กลางเมือง ต.ในเมือง"
     
374.     txtAmphur.Text = "เมืองขอนแก่น"
     
375.     txtProvinceName.Text = "ขอนแก่น"
     
376.     txtPostCode.Text = "40000"
     
377.     txtTelephone.Text = "08-9999-9999"
     
378.     txtFacsimile.Text = "043-999999"
     
379.     txtTotalAmount.Text = "0.00"
     
380.     txtInvBook.Text = "123456789"
     
381.     txtInvNumber.Text = "99999"
     
382.    
     
383.     ' ตั้งค่าเริ่มต้นให้กับ Spread
     
384.     Call SetupSpread
     
385.     ' โหลดข้อมูลทดสอบ
     
386.     Call DemoData
     
387.     ' คำนวณจำนวนเงินทั้งหมด
     
388.     Call CalTotalRow(1)
     
389. 
     
390. End Sub
     
391. 
     
392. ' / --------------------------------------------------------------------------------
     
393. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
     
394. ' / --------------------------------------------------------------------------------
     
395.     On Error Resume Next
     
396.     Dim Msg As String, Response%   ' Declare variables.
     
397.     Msg = "คุณแน่ใจว่าต้องการจบการทำงานของโปรแกรม ?"
     
398.     Response = MsgBox(Msg, vbQuestion + vbOKCancel + vbDefaultButton2, "ยืนยันการจบรายการ")
     
399.     Select Case Response
     
400.        Case vbCancel   ' Don't Allow close.
     
401.           Cancel = -1
     
402.       
     
403.        Case vbOK
     
404.             ' ลบไฟล์ขยะพวก Temporary ออกก่อนจบโปรแกรม
     
405.             If Dir$(App.Path & "\*.tmp") <> "" Then Kill App.Path & "\*.tmp"
     
406.             Set frmFarPoint2Excel = Nothing
     
407.             End
     
408.        'Case vbNo
     
409.     End Select
     
410. End Sub
     
411. 
     
412. Private Sub fpSpread1_Change(ByVal Col As Long, ByVal Row As Long)
     
413.     Select Case FpSpread1.ActiveCol
     
414.         ' หลักที่ 4 (หน่วยละ) - 5 (จำนวน)
     
415.         Case 4, 5
     
416.             Call CalTotalRow(Row)
     
417.    
     
418.     End Select
     
419. End Sub
     
420. 
     
421. ' / --------------------------------------------------------------------------------
     
422. ' / โปรแกรมย่อยคำนวณหาราคา x จำนวนในทุกๆแถวของตารางกริด (FarPoint)
     
423. ' / หากเกิดค่าเปลี่ยนแปลงในหลักที่ 4 และหลักที่ 5 จะมาคำนวณผลต่างๆที่นี่
     
424. Sub CalTotalRow(ByVal sRow As Long)
     
425. ' / --------------------------------------------------------------------------------
     
426.    
     
427.     Dim UnitPrice As Currency
     
428.     Dim Amount As Integer
     
429.     Dim i As Byte
     
430.     Dim sSum As Currency
     
431.    
     
432.     With FpSpread1
     
433.         ' รับค่าแถวปัจจุบัน
     
434.         .Row = sRow
     
435.         
     
436.         ' เก็บค่าในหลักที่ 4 ไว้ในตัวแปร
     
437.         .Col = 4
     
438.         ' .Text คือข้อมูลในเซลล์นั้นๆ เช่น จากหลักที่ 4 และแถวตามตัวแปร sRow ที่ถูกส่งมาจากเหตุการณ์ fpSpread1_Change
     
439.         UnitPrice = Format(.Text, "0.00")
     
440.         
     
441.         ' เก็บค่าในหลักที่ 5 ไว้ในตัวแปร
     
442.         .Col = 5
     
443.         Amount = Val(.Text)
     
444.         
     
445.         ' นำค่าในหลักที่ 4 (ราคาต่อหน่วย) คูณกับหลักที่ 5 (จำนวนสินค้า) ผลลัพธ์เก็บในหลักที่ 6 (จำนวนเงิน)
     
446.         .Col = 6
     
447.         .Text = Format(UnitPrice * Amount, "#,##0.00")
     
448.         ' รวมจำนวนเงินทั้งหมด ตั้งแต่แถวที่ 1 ไปถึงแถวที่ 17 ของ Spread (FarPoint)
     
449.         For i = 1 To .MaxRows
     
450.             ' ไล่ไปทีละแถว
     
451.             .Row = i
     
452.             ' ถ้าหลักที่ 6 ไม่ใช่ค่าว่าง ถึงจะเกิดการบวกได้
     
453.             ' เพราะต้องนับให้ครบ 17 แถว หากแถวใดที่ไม่มีการป้อนข้อมูลก็ต้องให้ข้ามไป
     
454.             If Trim(.Text) <> "" Then sSum = CDbl(.Text) + sSum
     
455.         Next
     
456.         
     
457.         ' แสดงจำนวนเงินทั้งหมด
     
458.         txtTotalAmount.Text = Format(sSum, "#,##0.00")
     
459.    
     
460.     End With
     
461.    
     
462. End Sub
     
463. 
     
464. ' / --------------------------------------------------------------------------------
     
465. ' / โปรแกรมย่อยเพื่อปรับระยะการแสดงผลของ Control ที่อยู่บนฟอร์ม
     
466. Private Sub Form_Resize()
     
467. ' / --------------------------------------------------------------------------------
     
468.     On Error Resume Next
     
469.    
     
470.     FpSpread1.Move 30, 3450, Me.ScaleWidth - 30, Me.ScaleHeight - _
     
471.                         fraMainData.Height - fraTotalData.Height - 30 '300
     
472.     fraMainData.Move 30, 0, Me.ScaleWidth - cmdExit.Width - 180
     
473.     fraTotalData.Move 30, 2640, fraMainData.Width
     
474.     txtTotalAmount.Move fraTotalData.Width - txtTotalAmount.Width
     
475.     lblTotalAmount.Move txtTotalAmount.Left - lblTotalAmount.Width
     
476.     cmdPrint2Excel.Move fraMainData.Width + 90
     
477.     cmdClear.Move cmdPrint2Excel.Left, cmdPrint2Excel.Top + cmdPrint2Excel.Height + 60
     
478.     cmdExit.Move cmdClear.Left, cmdClear.Top + cmdClear.Height + 60
     
479.    
     
480.     ' ตั้งค่าการขยายของ FarPoint ซึ่งต้องตั้งค่าตามหน่วย Twip ก่อน (1440 Twip = 2.54 ซม. หรือ 1 นิ้ว)
     
481.     With FpSpread1
     
482.         .UnitType = UnitTypeTwips
     
483.         .RowHeight(-1) = 365
     
484.         .ColWidth(2) = .Width \ 5 - 100
     
485.         .ColWidth(3) = .Width \ 5 - 75
     
486.         .ColWidth(4) = .Width \ 5 - 300
     
487.         .ColWidth(5) = .Width \ 5 - 300
     
488.         .ColWidth(6) = .Width \ 5 - 100
     
489.     End With
     
490.    
     
491. End Sub

คัดลอกไปที่คลิปบอร์ด

ดาวน์โหลดโค้ดต้นฉบับ VB6 ได้ที่นี่ ...

meawmill

<3 กำลังหาโค้ดประมาณนี้พอดีเลยค่ะ ขอบคุณมากๆเลยค่ะ
แต่อยากรู้ค่ะว่าถ้าเกิดว่าเราอยากจะพิมพ์ข้อมูลหนึ่งแถวต่อหนึ่งหน้ากระดาษ ต้องทำยังไงคะ รบกวนด้วยนะคะ

thongkorn

meawmill ตอบกลับเมื่อ 2018-11-29 08:50

มันเป็นยังไงครับ "พิมพ์ข้อมูล 1 แถว ต่อ 1 หน้ากระดาษ"

meawmill

thongkorn ตอบกลับเมื่อ 2018-11-29 14:24
มันเป็นยังไงครับ "พิมพ์ข้อมูล 1 แถว ต่อ 1 หน้ากระดาษ"

สมมุติว่า ได้ข้อมูลตามนี้นะคะ


แล้วต้องการปริ้นข้อมูลออกมา หนึ่งแถวต่อหนึ่งหน้ากระดาษ (กระดาษขนาด 22x10 cm)

ออกมาในลักษณะนี้ค่ะ



มีข้อมูล 15 แถว ก็ปริ้นออกมา ในรูปแบบแบบนี้ 15 หน้า ประมาณนี้อะค่ะ

พอเข้าใจมั้ยคะ