thongkorn โพสต์ 2018-11-28 15:49:28

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

http://www.g2gnet.com/webboard/images/vb6/farpoint2excel.jpg

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

การเลือก FarPoint Spread ActiveX
http://www.g2gnet.com/webboard/images/vb6/farpointcomponent.png
Project --> Components ...

มาดูโค้ดกันเถอะ ...
' / --------------------------------------------------------------------------------
' / 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)
' / MORE: http://www.g2gnet.com/webboard
' /
' / Purpose: Print receipt via Excel with VB6.
' / Microsoft Visual Basic 6.0 (SP6)
' /
' / This is open source code under @CopyLeft by Thongkorn Tubtimkrob.
' / You can modify and/or distribute without to inform the developer.
' / --------------------------------------------------------------------------------

Option Explicit

' / --------------------------------------------------------------------------------
' / โปรแกรมย่อยที่กำหนดค่าคุณสมบัติ (Properties) ต่างๆ ให้กับ Spread
Sub SetupSpread()
' / --------------------------------------------------------------------------------
    ' แสดงแถบแสงหรือไม่แสดง
    FpSpread1.OperationMode = OperationModeNormal   ' เอาไว้ป้อนข้อมูล
    'fpSpread1.OperationMode = OperationModeSingle    ' แถบ Selection
    'fpSpread.OperationMode = OperationModeRead   ' ไม่มีแถบ
    'fpSpread.OperationMode = OperationModeRow
   
    ' สามารถจัดเรียง หรือ Sort Order บนหัวคอลัมภ์ได้
    FpSpread1.UserColAction = UserColActionSort
   
    ' ปรับหน่วยวัด
    'fpSpread1.UnitType = UnitTypeNormal
    'fpSpread1.UnitType = UnitTypeTwips
    'FpSpread1.UnitType = UnitTypeVGABase
   
    ' การปรับความสูงของแถวทุกๆแถว (ค่า -1 หมายถึงทุกแถวครับ)
    FpSpread1.RowHeight(-1) = 18    ' หน่วยวัด Point
    FpSpread1.Appearance = Appearance3D
   
    ' เวลากด F2 เพื่อแก้ไขข้อมูลในแต่ละเซลล ์ให้เลือกข้อมูลทั้งหมด หรือสามารถเริ่มคีย์ค่าใหม่ได้ทันที
    FpSpread1.EditModeReplace = True
   
    ' ส่วนตัวอื่นๆ
    With FpSpread1
      ' หลักแรก คือ หลักที่ 0 ... จะเป็นการแสดงหมายเลขแถว เพื่ออ้างอิงในลักษณะ Excel เช่น
      .SetText 1, 0, "PK"
      .SetText 2, 0, "รหัสสินค้า"
      .SetText 3, 0, "รายละเอียด"
      .SetText 4, 0, "หน่วยละ"
      .SetText 5, 0, "จำนวน"
      .SetText 6, 0, "รวมจำนวนเงิน"
      
      ' จำนวนหลักทั้งหมด
      .MaxCols = 6
      ' จำนวนแถวสูงสุด 17 แถว (ผมนับจากใน MS Excel)
      .MaxRows = 17
      
      ' อย่าลืมเอา Primary Key ไปซ่อนไว้ไม่ให้ผู้ใช้งานเห็นด้วย ... ผู้ใช้งานจะได้ไม่สับสน
      .ColWidth(1) = 0
      ' จัดระยะความกว้างเอง หน่วยนับเหมือนใน .NET
      '.ColWidth(2) = 15
      '.ColWidth(3) = 15
      '.ColWidth(4) = 15
      '.ColWidth(5) = 12
      '.ColWidth(6) = 15
      
      ' กำหนดคุณสมบัติต่างๆของแต่ละหลักแบบ Run Time
      .Col = 2
      .TypeTextWordWrap = True
      .TypeVAlign = TypeVAlignCenter
      .Col = 3
      .TypeTextWordWrap = True
      .TypeVAlign = TypeVAlignCenter
      
      .Col = 4
      ' การจัดตำแหน่งแนวนอน
      .TypeHAlign = TypeHAlignRight
      ' การจัดตำแหน่งแนวตั้ง
      .TypeVAlign = TypeVAlignCenter
      ' กำหนดการป้อนค่าตัวเลขจำนวนเงินเท่านั้น
      .CellType = CellTypeCurrency
      ' ตามหลังจุศนิยม
      .TypeNumberDecPlaces = 2
      ' ไม้แสดงสัญลักษณ์ตัวเงิน
      .TypeCurrencyShowSymbol = False
      
      .Col = 5
      ' การจัดตำแหน่ง
      .TypeHAlign = TypeHAlignRight
      .TypeVAlign = TypeVAlignCenter
      .CellType = CellTypeNumber
      .TypeNumberDecPlaces = 0
      .TypeCurrencyShowSymbol = False
      
      .Col = 6
      ' ล็อคการคีย์ข้อมูล
      .Lock = True
      .TypeHAlign = TypeHAlignRight
      .TypeVAlign = TypeVAlignCenter
      .CellType = CellTypeCurrency
      .TypeCurrencyShowSymbol = False
      ' จุดทศนิยม 2 ตัว
      .TypeNumberDecPlaces = 2
      ' แสดงเครื่องหมายคอมม่า (,)
      .TypeCurrencyShowSep = True
   
    End With
   
End Sub

' / --------------------------------------------------------------------------------
' / โปรแกรมย่อยเคลียร์ค่าต่างๆในฟอร์มใหม่
Sub SetupScreen()
' / --------------------------------------------------------------------------------
    txtInvoiceNumber.Text = ""
    txtCustomerName.Text = ""
    txtAddress.Text = ""
    txtAmphur.Text = ""
    txtProvinceName.Text = ""
    txtPostCode.Text = ""
    txtTelephone.Text = ""
    txtFacsimile.Text = ""
    txtTotalAmount.Text = "0.00"
    txtInvBook.Text = ""
    txtInvNumber.Text = ""
   
    ' หรือเคลียร์ค่าใน TextBox Control แบบ Dynamic
    'Dim Ctl As Control
    'For Each Ctl In Me.Controls
    '    If TypeOf Ctl Is TextBox Then Ctl.Text = ""
    'Next
   
End Sub

' / --------------------------------------------------------------------------------
' / ข้อมูลทดสอบ เพราะขี้เกียจพิมพ์ใหม่ทุกครั้ง 55555+
Sub DemoData()
' / --------------------------------------------------------------------------------
    'FpSpread1.ActiveSheet
    ' ใส่ข้อมูลทดสอบ
    With FpSpread1
            .Row = 1
            '.ActiveSheet.Cells(1, 1) = 1
            '.ActiveSheet.Cells(1, 2) = "8851234567890"
            .Col = 1: .Text = 1
            .Col = 2: .Text = "8851234567890"
            .Col = 3: .Text = "คู่มือการเมาอย่างถูกต้อง"
            .Col = 4: .Text = "599.00"
            .Col = 5: .Text = "10"
            .Col = 6: .Text = "5990.00"
            .Row = 2
            .Col = 1: .Text = 2
            .Col = 2: .Text = "8850987654321"
            .Col = 3: .Text = "CD หนัง X เพื่อการศึกษา"
            .Col = 4: .Text = "999.00"
            .Col = 5: .Text = "10"
            .Col = 6: .Text = "9990.00"
            .Row = 3
            .Col = 1: .Text = 3
            .Col = 2: .Text = "8850123456789"
            .Col = 3: .Text = "หนังสือดี"
            .Col = 4: .Text = "100.00"
            .Col = 5: .Text = "20"
            .Col = 6: .Text = "2000.00"
    End With
   
End Sub

' / --------------------------------------------------------------------------------
' / โปรแกรมย่อยเพื่อเคลียร์ค่าต่างๆใหม่หมด
Private Sub cmdClear_Click()
' / --------------------------------------------------------------------------------
    ' เคลียร์ข้อมูลใน TextBox Control ทั้งหมด
    Call SetupScreen
    ' ลบแถวออกทั้งหมดเริ่มจากแถวที่ 1 ถึง 17
    FpSpread1.DeleteRows 1, 17

End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

' / --------------------------------------------------------------------------------
' / โปรแกรมย่อยในการส่งข้อมูลทั้งในตาราง FarPoint หรือบนฟอร์มไปให้กับ MS Excel
Private Sub cmdPrint2Excel_Click()
' / --------------------------------------------------------------------------------
    On Error GoTo ErrorHandler
   
    ' ประกาศตัวแปรใช้งาน Excel Object (Application)
    Dim ExcelAppAs New Excel.Application
   
    ' ประกาศตัวแปรใช้งาน WorkSheet ของ ExcelApp Object
    Dim ExcelSheet As New Excel.Worksheet
   
    ' ประกาศตัวแปรใช้งาน WorkBook ของ ExcelApp Object
    Dim ExcelBook As New Excel.Workbook

    ' สร้าง Excel Object ขึ้นมาใช้งาน ในชื่อ ExcelApp
    Set ExcelApp = CreateObject("Excel.Application")
    'Set ExcelApp = New Excel.Application

    ' เปิด WorkBook เดิม ก็ใช้ Open Method ตามด้วยไฟล์ที่ต้องการเอาครับ
    Set ExcelBook = ExcelApp.Workbooks.Open(App.Path & "\ReceiptG2GNet.xls")
    ' / --------------------------------------------------------------------------------
    ' การคัดลอก Sheet ต้นแบบ (Sheet1) ไปยัง Sheet ตัวใหม่ก่อน ... มันจะตั้งค่าสำเนาให้อัตโนมัติ
    ' เช่น Sheet(1), Sheet(2) ... มันมาจากการกำหนดค่าด้วย ExcelBook.Worksheets.Count
    ' ซึ่งมันจะไปต่อท้าย Sheet ล่าสุดที่มีอยู่ เพราะเราสั่งด้วย After (หากอยากให้ไปอยู่ข้างหน้า ก็ใช้ Before แทน)
    ' การสั่งแบบนี้หมายถึงให้คัดลอกทั้ง Sheet ไม่ว่าจะเป็นข้อมูล กล่องข้อความ ภาพ Shape และอื่นๆ ... มันก็จะไปหมดเลย
    ExcelBook.Worksheets(1).Copy After:=ExcelBook.Worksheets(ExcelBook.Worksheets.Count)
    ' หรืออ้างถึงชื่อ Sheet โดยตรงก็ได้ ... แต่ต้องอ้างถึงชื่อ Sheet ให้ถูกล่ะกันครับ
    ' ExcelBook.Worksheets("Sheet1").Copy After:=ExcelBook.Worksheets(ExcelBook.Worksheets.Count)
    ' / --------------------------------------------------------------------------------
   
    ' หรือ หากต้องการเปลี่ยนชื่อ Sheet เช่น เอาวันที่ + เวลา มาผสมกัน ... ก็ทำได้โดยใช้ Name Method
    ' Sheets(ExcelBook.Worksheets.Count).Name = Format(Now(), "ddmmyyyy") & _
                "-" & Format(Now(), "hhmmss")
   
    ' กำหนดให้ใช้งาน Sheet ปัจจุบัน (ไม่ใช้งานก็ได้ มันไปที่ Sheet ใหม่อยู่แล้วครับ)
    Set ExcelSheet = ExcelApp.Workbooks.Application.ActiveSheet

    Dim fpRow As Integer   ' เริ่มต้นการอ่านข้อมูลแถวแรกในตารางกริด
    Dim xlsRow As Integer    ' เริ่มต้นแถวแรกที่เก็บข้อมูลใน MS Excel

    ' กำหนดตำแหน่งส่งข้อมูลไป Excel โดยจะเริ่มต้นรับข้อมูลจากแถวที่ 13 และ หลักที่ 1 (A13)
    ' คือเราสามารถอ้างอิงถึงได้ทั้งแถว หลัก หรือ Cell ตำแหน่งนั้นๆเลย หรือ จะใช้ Range แทนก็ได้
    ' แถว/หลักแรกที่กำหนด อันนี้ก็ต้องขึ้นอยู่กับรูปแบบฟอร์มที่เราออกแบบเองด้วยน่ะขอรับ ...
    xlsRow = 13
   
    ' เริ่มต้นแถวที่ 1 ไปตามจำนวนแถวทั้งหมดของ FarPoint
    For fpRow = 1 To FpSpread1.MaxRows
         With FpSpread1
            
            ' รหัสสินค้า (ใส่เครื่องหมาย Single Quote เพื่อป้องกันรหัสสินค้าที่นำหน้าด้วย 0)
            .Col = 2: .Row = fpRow
            ExcelApp.Cells(xlsRow, 1) = CStr("'" & .Text)
            
            ' ชื่อสินค้า
            .Col = 3
            ExcelApp.Cells(xlsRow, 2) = "" & .Text
            
            ' การจัดรูปแบบการแสดงผลตัวเลข เช่น 1,250.00 ผมจัดเอาไว้อยู่ใน Excel เองน่ะครับ
            ' ราคาต่อหน่วย
            .Col = 4
            ExcelApp.Cells(xlsRow, 3) = "" & .Text
            ' จำนวน
            .Col = 5
            ExcelApp.Cells(xlsRow, 4) = "" & .Text
            ' รวมจำนวนเงิน
            .Col = 6
            ExcelApp.Cells(xlsRow, 5) = "" & .Text
            
            ' เพิ่มจำนวนแถวใน Excel ขึ้นอีก 1
            xlsRow = xlsRow + 1
            ' เทคนิค ... ความเป็นจริงเราสามารถลดการใช้งานตัวแปร xlsRow ออกไปก็ได้
            ' เรารู้ว่า fpRow เริ่มต้นที่ 1 ... เรารู้ว่าใน Excel ต้องเริ่มต้นรับข้อมูลในแถวที่ 13 (ต่างกัน 12)
            ' ดังนั้นปลด xlsRow ออกไป แล้วให้ใช้ fpRow + 12 แทนยังไงล่ะครับ ... พี่น้อง ม่วนหลายๆ
            ' แต่ที่ผมทำตัวอย่างออกมาก็เพื่อไม่อยากให้มือใหม่ๆได้งง จะได้อ่านโค้ดง่ายขึ้นครับ
      End With
    Next
   
    ' นำรายละเอียดต่างๆไปแสดงผลใน Excel คือชื่อลูกค้า (แถวที่ 6 หลักที่ 1 หรือเซลล์ A6)
    ExcelApp.Cells(6, 1) = "" & "ชื่อลูกค้า: " & Trim(txtCustomerName.Text)
   
    ' ที่อยู่ลูกค้า แถวที่ 7 หลักที่ 1 หรือเซลล์ A7
    ExcelApp.Cells(7, 1) = "" & "ที่อยู่: " & Trim(txtAddress.Text) & vbCrLf & _
                Trim$(txtAmphur.Text) & "" & Trim$(txtProvinceName.Text) & "" & _
                Trim$(txtPostCode.Text) & vbCrLf & _
                "โทร. " & Trim$(txtTelephone.Text)
    ' วันที่ แสดงผลแถวที่ 6 หลักที่ 3 หรือเซลล์ C6
    ExcelApp.Cells(6, 3) = "วันที่ " & Format(Now(), "dd/mm/yyyy")
   
    ' ใบเสร็จเลขที่/เล่มที่/เลขที่
    If Trim(txtInvoiceNumber.Text) <> "" Or Len(Trim$(txtInvoiceNumber.Text)) <> 0 Then _
      ExcelApp.Cells(1, 4) = "ใบเสร็จเลขที่ " & Trim(txtInvoiceNumber.Text)
    If Trim(txtInvBook.Text) <> "" Or Len(Trim$(txtInvBook.Text)) <> 0 Then _
      ExcelApp.Cells(2, 4) = "เล่มที่ " & Trim(txtInvBook.Text)
    If Trim(txtInvNumber.Text) <> "" Or Len(Trim$(txtInvNumber.Text)) <> 0 Then _
      ExcelApp.Cells(3, 4) = "เล่มที่ " & Trim(txtInvNumber.Text)
   
    ' แสดงผลโปรแกรม Excel ขึ้นมาให้ User มองเห็น
    ExcelApp.Visible = True
    ' บันทึกข้อมูลทับไฟล์เดิมแบบอัติโนมัติทันที แต่เพิ่ม Sheet ใหม่
    ExcelBook.Save
   
    ' / --------------------------------------------------------------------------------
    ' / การบันทึกไฟล์มีหลาย Option มากมายให้เลือก คงต้องไปลองศึกษาเพิ่มเติมกันเองน่ะครับ
    ' / --------------------------------------------------------------------------------
   
    ' / --------------------------------------------------------------------------------
    ' กรณีที่ต้องการบันทึกไฟล์ใหม่ เราจะบังคับตั้งชื่อไฟล์ให้เอง
    'Dim FileXLS1 As String
    'FileXLS1 = "\Receipt" & Format(Date, "ddmmyyyy") & "-" & Format(Time, "hhmmss") & ".xls"
    ' บันทึกชื่อไฟล์ใหม่ เป็นชื่อไฟล์วันที่เวลา เช่น Receipt03042555-123015
    'ExcelBook.SaveAs (App.Path & FileXLS1)
    'ExcelBook.Close False, (App.Path & FileXLS1)
    ' / --------------------------------------------------------------------------------
   
    ' / --------------------------------------------------------------------------------
    ' กรณีที่ต้องการบันทึกไฟล์ใหม่ แต่เลือกบันทึกชื่อไฟล์ใหม่ได้
    'Dim FileXLS2 As Variant
    'FileXLS2 = ExcelApp.Application.GetSaveAsFilename( _
      FileFilter:="Excel Files, *.xls, All Files, *.*", _
      Title:="[Save As - บันทึกชื่อไฟล์ใหม่")
    ' หากมีการกดปุ่ม Cancel เพื่อยกเลิก
    'If FileXLS2 = False Then Exit Sub
   
    'If LCase$(Right$(FileXLS2, 4)) <> ".xls" Then FileXLS2 = FileXLS2 & ".xls"
   
    ' บันทึกไฟล์ในชื่อใหม่
    'ExcelApp.ActiveWorkbook.SaveAs FileName:=FileXLS2
    ' หาก Save ไฟล์ใหม่แบบนี้ ควรปิดการแสดงผลของ Excel ก่อน นั่นคือจากบรรทัดด้านบน
    ' ควรกำหนดให้ ExcelApp.Visible = Fale เพื่อไม่ให้ Excel แสดงขึ้นมา
    ' หรือลงไปบรรทัดข้างล่างกำหนดให้ปิด Excel คือ Excel.Application.Quit ออกไปเลย
    ' / --------------------------------------------------------------------------------

    ' ล้างให้ออก ... จาก Memory ของฉัน ... 55555+
    Set ExcelSheet = Nothing:    Set ExcelBook = Nothing
    ' หรือต้องการปิดโปรแกรม Excel ไปเลย
    'ExcelApp.Application.Quit
   
    Set ExcelApp = Nothing
   
ExitProc:
    ' แม้ว่าจะสั่งปิดโปรแกรม Excel ออกไปแล้วแต่มันยังค้างอยู่ (ไปดูที่ Process น่ะครับ)
    ' ดังนั้นสั่งผ่าน Shell เพื่อ Kill Process ของ Excel ก่อน (/F = Force คือบังคับมันเลย)
    'Shell "TaskKill /F /IM Excel.exe"
    Exit Sub
   
ErrorHandler:
   
    ' ขณะโปรแกรมกำลังทำงาน (Run Time) ดัก Error จาก On Error GoTo ErrorHandler
    Select Case Err.Number
      Case 462:
            MsgBox "กรุณาจบการทำงานของโปรแกรมก่อนที่จะบันทึกไฟล์ Excel อีกครั้ง", _
                vbOKOnly + vbExclamation, "รายงานความผิดพลาด"
      Case Else
            MsgBox "ความผิดพลาด: " & vbCrLf & Err.Number & vbCrLf & Err.Description
    End Select
    ' ปกติให้ออกจากโปรแกรมจากจุดนี้ได้เลย แต่ที่ให้กระโดดกลับไปก็เพราะเผื่อมีงานอื่นที่ต้องทำก่อนจบการทำงาน
    Resume ExitProc

End Sub

' / --------------------------------------------------------------------------------
' / จะใช้งานการกด KeyDown เช่นพวกปุ่มฟังค์ชั่นต่างๆได้
' / จะต้องกำหนดให้คุณสมบัติของฟอร์ม KeyPreview = True ก่อนด้วย
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
' / --------------------------------------------------------------------------------
    Select Case KeyCode
      
      Case vbKeyF1: 'MsgBox "No help now."
      Case vbKeyF6: Call cmdPrint2Excel_Click
      Case vbKeyF10: Unload Me
   
   End Select
End Sub

' / --------------------------------------------------------------------------------
' / เริ่มต้นการทำงาน
Private Sub Form_Load()
' / --------------------------------------------------------------------------------
    ' ป้องกันการเรียกใช้โปรแกรมซ้อนกัน
    If App.PrevInstance Then End
   
    ' จัดฟอร์มอยู่กึ่งกลางหน้าจอ
    Me.Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
   
    Call SetupScreen
    ' หรือกำหนดค่าทดสอบเอง (ขี้เกียจพิมพ์ตอนสั่งรัน 5555+)
    txtInvoiceNumber.Text = "INV55-000001"
    txtCustomerName.Text = "บุญห่อ พ่อรวย"
    txtAddress.Text = "999 ม.1 ซอย 39 ถ.กลางเมือง ต.ในเมือง"
    txtAmphur.Text = "เมืองขอนแก่น"
    txtProvinceName.Text = "ขอนแก่น"
    txtPostCode.Text = "40000"
    txtTelephone.Text = "08-9999-9999"
    txtFacsimile.Text = "043-999999"
    txtTotalAmount.Text = "0.00"
    txtInvBook.Text = "123456789"
    txtInvNumber.Text = "99999"
   
    ' ตั้งค่าเริ่มต้นให้กับ Spread
    Call SetupSpread
    ' โหลดข้อมูลทดสอบ
    Call DemoData
    ' คำนวณจำนวนเงินทั้งหมด
    Call CalTotalRow(1)

End Sub

' / --------------------------------------------------------------------------------
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
' / --------------------------------------------------------------------------------
    On Error Resume Next
    Dim Msg As String, Response%   ' Declare variables.
    Msg = "คุณแน่ใจว่าต้องการจบการทำงานของโปรแกรม ?"
    Response = MsgBox(Msg, vbQuestion + vbOKCancel + vbDefaultButton2, "ยืนยันการจบรายการ")
    Select Case Response
       Case vbCancel   ' Don't Allow close.
          Cancel = -1
      
       Case vbOK
            ' ลบไฟล์ขยะพวก Temporary ออกก่อนจบโปรแกรม
            If Dir$(App.Path & "\*.tmp") <> "" Then Kill App.Path & "\*.tmp"
            Set frmFarPoint2Excel = Nothing
            End
       'Case vbNo
    End Select
End Sub

Private Sub fpSpread1_Change(ByVal Col As Long, ByVal Row As Long)
    Select Case FpSpread1.ActiveCol
      ' หลักที่ 4 (หน่วยละ) - 5 (จำนวน)
      Case 4, 5
            Call CalTotalRow(Row)
   
    End Select
End Sub

' / --------------------------------------------------------------------------------
' / โปรแกรมย่อยคำนวณหาราคา x จำนวนในทุกๆแถวของตารางกริด (FarPoint)
' / หากเกิดค่าเปลี่ยนแปลงในหลักที่ 4 และหลักที่ 5 จะมาคำนวณผลต่างๆที่นี่
Sub CalTotalRow(ByVal sRow As Long)
' / --------------------------------------------------------------------------------
   
    Dim UnitPrice As Currency
    Dim Amount As Integer
    Dim i As Byte
    Dim sSum As Currency
   
    With FpSpread1
      ' รับค่าแถวปัจจุบัน
      .Row = sRow
      
      ' เก็บค่าในหลักที่ 4 ไว้ในตัวแปร
      .Col = 4
      ' .Text คือข้อมูลในเซลล์นั้นๆ เช่น จากหลักที่ 4 และแถวตามตัวแปร sRow ที่ถูกส่งมาจากเหตุการณ์ fpSpread1_Change
      UnitPrice = Format(.Text, "0.00")
      
      ' เก็บค่าในหลักที่ 5 ไว้ในตัวแปร
      .Col = 5
      Amount = Val(.Text)
      
      ' นำค่าในหลักที่ 4 (ราคาต่อหน่วย) คูณกับหลักที่ 5 (จำนวนสินค้า) ผลลัพธ์เก็บในหลักที่ 6 (จำนวนเงิน)
      .Col = 6
      .Text = Format(UnitPrice * Amount, "#,##0.00")
      ' รวมจำนวนเงินทั้งหมด ตั้งแต่แถวที่ 1 ไปถึงแถวที่ 17 ของ Spread (FarPoint)
      For i = 1 To .MaxRows
            ' ไล่ไปทีละแถว
            .Row = i
            ' ถ้าหลักที่ 6 ไม่ใช่ค่าว่าง ถึงจะเกิดการบวกได้
            ' เพราะต้องนับให้ครบ 17 แถว หากแถวใดที่ไม่มีการป้อนข้อมูลก็ต้องให้ข้ามไป
            If Trim(.Text) <> "" Then sSum = CDbl(.Text) + sSum
      Next
      
      ' แสดงจำนวนเงินทั้งหมด
      txtTotalAmount.Text = Format(sSum, "#,##0.00")
   
    End With
   
End Sub

' / --------------------------------------------------------------------------------
' / โปรแกรมย่อยเพื่อปรับระยะการแสดงผลของ Control ที่อยู่บนฟอร์ม
Private Sub Form_Resize()
' / --------------------------------------------------------------------------------
    On Error Resume Next
   
    FpSpread1.Move 30, 3450, Me.ScaleWidth - 30, Me.ScaleHeight - _
                        fraMainData.Height - fraTotalData.Height - 30 '300
    fraMainData.Move 30, 0, Me.ScaleWidth - cmdExit.Width - 180
    fraTotalData.Move 30, 2640, fraMainData.Width
    txtTotalAmount.Move fraTotalData.Width - txtTotalAmount.Width
    lblTotalAmount.Move txtTotalAmount.Left - lblTotalAmount.Width
    cmdPrint2Excel.Move fraMainData.Width + 90
    cmdClear.Move cmdPrint2Excel.Left, cmdPrint2Excel.Top + cmdPrint2Excel.Height + 60
    cmdExit.Move cmdClear.Left, cmdClear.Top + cmdClear.Height + 60
   
    ' ตั้งค่าการขยายของ FarPoint ซึ่งต้องตั้งค่าตามหน่วย Twip ก่อน (1440 Twip = 2.54 ซม. หรือ 1 นิ้ว)
    With FpSpread1
      .UnitType = UnitTypeTwips
      .RowHeight(-1) = 365
      .ColWidth(2) = .Width \ 5 - 100
      .ColWidth(3) = .Width \ 5 - 75
      .ColWidth(4) = .Width \ 5 - 300
      .ColWidth(5) = .Width \ 5 - 300
      .ColWidth(6) = .Width \ 5 - 100
    End With
   
End Sub
ดาวน์โหลดโค้ดต้นฉบับ VB6 ได้ที่นี่ ...

meawmill โพสต์ 2018-11-29 08:50:29

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

thongkorn โพสต์ 2018-11-29 14:24:33

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


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

meawmill โพสต์ 2018-11-30 08:40:51

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

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


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

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



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

พอเข้าใจมั้ยคะ {:3_60:}


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