ขอช่วยเรื่องการจัดระบบฐานข้อมูลที่ถูกต้องค่ะ

[snasui]

กำหนดตามนี้ก็พอแล้วครับ สิ่งที่ต้องทำต่อไปคือ Copy ค่าต้นทางที่ต้องการมาวางที่ตัวแปร rd ครับ

[suka]

เรียนอาจารย์ค่ะ Code ด้านล่างนี้ใช้บันทึกไปที่ชีท Sheet1 ไฟล์ PoBookShare ใช้ได้ตรงตามต้องการค่ะ

Code: Select all

  With formBook
    i = Worksheets("Enterthedata").Range("C225")
    End With
    With Worksheets("Template")
        Set rs = .Range(.Range("A2"), .Range("AC" & i + 1))
    End With
    Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    If Worksheets("Enterthedata").Range("C225") = True Then
    End If

Code ด้านล่างนี้ต้องการให้บันทึกไปที่ชีท Database ของไฟล์ PO.Form Code นี้ไม่ทำงานเลยค่ะ ต้องปรับแก้อย่างไรคะ

Code: Select all

With formBook
    i = Worksheets("Enterthedata").Range("C225")
    End With
    With Worksheets("Template")
        Set rs = .Range(.Range("A2"), .Range("AC" & i + 1))
    End With
    Set rd = formBook.Sheets("Database").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    If Worksheets("Enterthedata").Range("C225") = True Then
        MsgBox "Please check your data. This transaction already recorded."
        Exit Sub
    End If

[snasui]

Code ด้านบนก็ไม่ควรจะทำงานเช่นเดียวกัน เพราะยังไม่มี Code สำหรับการ Copy rs ไปวางที่ rt

การจะให้ข้อมูลต้นทางไปวางปลายทางวิธีหนึ่งคือการ Copy แล้วนำไปวาง ไม่ทราบว่าบรรทัดใดที่ใน Code ที่เขียนมาด้านบนแสดงการ Copy แล้วนำไปวางครับ

[suka]

ทำได้แล้วค่ะอาจารย์ เป็นเพราะไม่ได้กำหนดจุดนี้นี่เองค่ะ ขอบพระคุณมากๆค่ะ

Code: Select all

rs.Copy: rt.PasteSpecial xlPasteValues
rs.Copy: rd.PasteSpecial xlPasteValues

[suka]

เรียนอาจารย์ ช่วยแนะการปรับแก้ Code

Code: Select all

Sub BeenArL()                               
    Dim wbShare As Workbook
    Dim wdShare As Workbook
    Dim formBook As Workbook
    Dim rSource As Range
    Dim rTarget As Range
    Dim rs As Range
    Dim rt As Range
    Dim i As Double
    Set formBook = ThisWorkbook
    Set wbShare = Workbooks("ArBookShare.xlsx")
    Set wdShare = Workbooks("PoBookShare.xlsx")
    With formBook.Sheets("Form")
        Set rSource = .Range("B3:B50")
    End With
    With formBook.Sheets("Database")
        Set rTarget = .Range("E2", .Range("E" & Rows.Count).End(xlUp))
    End With
    With formBook.Sheets("Form")
        i = (.Range("L9") + .Range("M9") + .Range("M12"))
        If i <> .Range("J12") Then
            MsgBox "โปรดตรวจจำนวนเงินและบันทึกใหม่"
        End If
    End With
    Application.Calculation = xlCalculationManual
    For Each rs In rSource
        For Each rt In rTarget
            If rt = rs Then rt wdShare.Sheets("Sheet1").Offset(0, 25) = "Y"
        Next rt
    Next rs
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    With formBook.Sheets("TemBilling")
    .Range("a2:p2").Resize(.Range("q1")).Copy
    End With
    wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    With formBook.Sheets("TemBilling")
    .Range("P10:W10").Resize(.Range("Y9")).Copy
    End With
    formBook.Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    formBook.Sheets("Form").Range("G4:G8,H1,J2,I4:N8,I6").ClearContents
    With formBook.Sheets("Form")
        .Range("J10") = .Range("J10") + 1
    End With
    Application.ScreenUpdating = True
      Windows("AR.Form By Su.xlsm").Activate       
    ActiveWorkbook.Save
    Windows("ArBookShare.xlsx").Activate
    ActiveWorkbook.Save
End Sub

Code ด้างล่างนี้มีปัญหาค่ะ ไม่สามารถใส Y ที่คอลัมน์ AD ชีท PoBookShare ค่ะ

Code: Select all

For Each rs In rSource
        For Each rt In rTarget
            If rt = rs Then rt wdShare.Sheets("Sheet1").Offset(0, 25) = "Y"
        Next rt
    Next rs

เป็นตามรูปแนบค่ะ

[snasui]

Code นี้ไม่ถูกต้องครับ ให้กลับไปดูตัวอย่างว่าของเดิมที่ทำงานได้เขียนไว้ว่าอย่างไร

Code: Select all

rt wdShare.Sheets("Sheet1").Offset(0, 25) = "Y"

[suka]

ทำได้แล้วค่ะอาจารย์ ปรับเปลียน Code นี้

Code: Select all

 With formBook.Sheets("Database")

เป็นตามนี้ค่ะ ขอบพระคุณค่ะ

Code: Select all

With wdShare.Sheets("Sheet1")

[suka]

เรียนอาจารย์คะรบกวนช่วยด้วยค่ะ Code ด้านล่างนี้ ต้องการให้เมื่อกดปุ่ม Record แล้วไฟล์ PoBookShare ยังไม่เปิดก็ให้เปิดไฟล์ขึ้นมา หากเปิดอยู่แล้วก็ทำขั้นตอนถัดไปค่ะ Code ที่ใช้มี Comment ด้านหล้งค่ะ

Code: Select all

Sub BeenArL()
    Dim wbShare As Workbook
    Dim wdShare As Workbook
    Dim formBook As Workbook
    Dim rSource As Range
    Dim rTarget As Range
    Dim wdOpen As Boolean                         'wbOpen
    Dim rs As Range
    Dim rt As Range
    Dim i As Double
    Set formBook = ThisWorkbook
    Set wbShare = Workbooks("ArBookShare.xlsx")
    Set wdShare = Workbooks("PoBookShare.xlsx")
    
    For Each wdShare In Workbooks                  'wbOpen
        If wdShare.Name = "PoBookShare.xlsx" Then  'wbOpen
            wdOpen = True                          'wbOpen
    Next wd                                        'wbOpen
    If Not wdOpen Then                             'wbOpen
    End If                                         'wbOpen
    
    With formBook.Sheets("Form")
        Set rSource = .Range("B3:B50")
    End With
    With wdShare.Sheets("Sheet1")
        Set rTarget = .Range("E2", .Range("E" & Rows.Count).End(xlUp))
    End With
    With formBook.Sheets("Form")
        i = (.Range("L9") + .Range("M9") + .Range("M12"))
        If i <> .Range("J12") Then
            MsgBox "โปรดตรวจจำนวนเงินและบันทึกใหม่"
        End If
    End With
    Application.Calculation = xlCalculationManual
    For Each rs In rSource
        For Each rt In rTarget
            If rt = rs Then rt.Offset(0, 25) = "Y"
        Next rt
    Next rs
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    With formBook.Sheets("TemBilling")
    .Range("a2:p2").Resize(.Range("q1")).Copy
    End With
    wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    With formBook.Sheets("TemBilling")
    .Range("P10:W10").Resize(.Range("Y9")).Copy
    End With
    formBook.Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    formBook.Sheets("Form").Range("G4:G8,H1,I4:N8,M12").ClearContents
    With formBook.Sheets("Form")
        .Range("J10") = .Range("J10") + 1
    End With
    Application.ScreenUpdating = True
    Windows("AR.Form.xlsm").Activate
        ActiveWorkbook.Save
    Windows("ArBookShare.xlsx").Activate
        ActiveWorkbook.Save
    Windows("PoBookShare.xlsx").Activate
        ActiveWorkbook.Save
   End Sub

พอลองรันแล้วฟ้องตามรูปค่ะ

[snasui]

ลองบันทึก Macro การเปิด Workbook แล้วนำ Code นั้นมาปรับใช้ สำหรับการฟ้อง Error นั้นเพราะยังไม่ได้กำหนดตัวแปร โปรแกรมจึงไม่รู้จักตัวแปรนั้นครับ

[suka]

อาจารย์คะ ไฟล์ PoBookShare ได้มีการกำหนดตัวแปรนี้อยู่แล้ว ตามด้านล่างนี้ไม่สามารถนำมาใช้ได้หรือคะ

Code: Select all

 Set wdShare = Workbooks("PoBookShare.xlsx")

[snasui]

ภาพ Error ที่แนบมาเป็นตัวแปร wd ครับ ไม่เกี่ยวกับ WdShare ครับ

[suka]

อาจารย์คะขอรบกวนช่วยเรื่องกำหนดตัวแปรกับให้ wd ค่ะ ความต้องการเมื่อไฟล์ PoBookShare ยังไม่เปิดก็ให้เปิดไฟล์ขึ้นมา หากเปิดอยู่แล้วก็ทำขั้นตอนถัดไปค่ะ Code ด้านล่างนี้ที่มี Comment ด้านหล้งยังใช้ไม่ได้ค่ะ

Code: Select all

Dim wbShare As Workbook
    Dim wdShare As Workbook
    Dim formBook As Workbook
    Dim rSource As Range
    Dim rTarget As Range
    Dim wdOpen As Boolean                         'wbOpen
    Dim rs As Range
    Dim rt As Range
    Dim i As Double
    Dim wb As Workbook                              'wbOpen
    Set formBook = ThisWorkbook
    Set wbShare = Workbooks("ArBookShare.xlsx")
    Set wdShare = Workbooks("PoBookShare.xlsx")
    
    For Each wd In Workbooks                       'wbOpen
    Set wd = PoBookShare.Sheets("sheets1").Open    'wbOpen
        If wd.Name = "PoBookShare.xlsx" Then      'wbOpen
            wdOpen = True                          'wbOpen
    Next wd                                         'wbOpen
    If Not wdOpen Then                             'wbOpen
    Workbooks.Open Filename:="\\Server\DATA (E)\My P S  Project.xls\PS.BookShare\PO\PoBookShare.xlsx"
    End If                                         'wbOpen
    

[snasui]

ตัวอย่างการ Loop เพื่อหาว่าไฟล์นั้นเปิดอยู่หรือไม่สามารถใช้ Code ตามด้านล่างครับ

Code: Select all

For Each wd In Workbooks
    If wd.Name = "PoBookShare.xlsx" Then
        wdOpen = True
    End If
Next wd

ตัวอย่าง Code สำหรับตรวจสอบว่าหากไฟล์นั้นไม่ได้เปิดอยู่ก็ให้เปิดขึ้นมาคือด้านล่างครับ

Code: Select all

If Not wdOpen Then
    Workbooks.Open Filename:="\\Server\DATA (E)\My P S  Project.xls\PS.BookShare\PO\" & wdShare
End If

[suka]

อาจารย์คะขอรบกวนอีกรอบค่ะ ลองเพิ่ม Code สองบรรทัดล่างนี้ยังไม่ได้เลยค่ะ

Code: Select all

Dim wdOpen As Boolean
Dim wd As Workbook

เป็นตามภาพด้างล่างนี้แก้อย่างไรคะ

[snasui]

ในภาพประกาศตัวแปร wd เป็น Range จึงเป็นปกติที่จะ Error ครับ

[suka]

อาจารย์คะ ใส่ Code บรรทัดนี้แล้ว error ค่ะ

Code: Select all

Dim wd As Workbook

ตามภาพนี้ค่ะ

[snasui]

Code ตามภาพที่แนบมาไม่เกี่ยวกับ wd แต่เกี่ยวกับ wdOpen ครับ ซึ่งยังไม่เห็นว่ามีการประกาศตัวแปรครับ

[suka]

อาจารย์คะ ได้เพิ่ม

Code: Select all

Dim wdOpen As Boolean

แล้วพอลองไม่เปิดไฟล์ PoBookShare แล้วรันดูก็ error ค่ะ

Code: Select all

[code]Sub BeenArL()                                
    Dim wbShare As Workbook
    Dim wdShare As Workbook
    Dim formBook As Workbook
    Dim wdOpen As Boolean
    Dim wd As Workbook
    Dim rSource As Range
    Dim rTarget As Range
    Dim rs As Range
    Dim rt As Range
    Dim i As Double
    Set formBook = ThisWorkbook
    Set wbShare = Workbooks("ArBookShare.xlsx")
    Set wdShare = Workbooks("PoBookShare.xlsx")
    For Each wd In Workbooks
    If wd.Name = "PoBookShare.xlsx" Then
        wdOpen = True
    End If
    Next wd
    If Not wdOpen Then
    Workbooks.Open Filename:="\\Server\DATA (E)\My P S  Project.xls\PS.BookShare\PO.ใบส่งสินค้า\PoBookShare.xlsx"
    End If
    

[/code]
เป็นตามภาพนี้ค่ะ

[snasui]

การจะกำหนดค่าให้ตัวแปร wdShare ได้จะต้องเปิดไฟล์นั้นไว้ก่อนครับ หากไม่ได้เปิดไว้จะไปกำหนดค่าให้กับ wdShare ไม่ได้

หลัก ๆ ขอสรุปให้ตามนี้ครับ

1. ประกาศตัวแปร wdShare เป็น Workbook
2. ทำการ Loop หาว่า PoBookShare.xlsx เปิดอยู่หรือไม่ หากเปิดอยู่ค่อยกำหนดค่าตัวแปรเป็น set wdShare = Workbooks("PoBookShare.xlsx") หากปิดอยู่ก็ให้เปิดขึ้นมาก่อนแล้วค่อยกำหนดค่าตัวแปร

[suka]

อาจารย์คะ เปลี่ยน Code เป็นตามนี้ค่ะ

Code: Select all

Sub BeenArL()                                
    Dim wbShare As Workbook
    Dim wdShare As Workbook
    Dim formBook As Workbook
    Dim wdShareOpen As Boolean
    Dim rSource As Range
    Dim rTarget As Range
    Dim rs As Range
    Dim rt As Range
    Dim i As Double
    Set formBook = ThisWorkbook
    Set wbShare = Workbooks("ArBookShare.xlsx")
    Set wdShare = Workbooks("PoBookShare.xlsx")
    For Each wdShare In Workbooks
    If wdShare.Name = "PoBookShare.xlsx" Then
        wdShareOpen = True
    End If
    Next wdShare
    If Not wdShareOpen Then
    Workbooks.Open Filename:="\\Server\DATA (E)\My P S  Project.xls\PS.BookShare\PO.ใบส่งสินค้า\PoBookShare.xlsx"
    End If

    With formBook.Sheets("Form")
        Set rSource = .Range("B3:B50")
    End With
    With wdShare.Sheets("Sheet1")
        Set rTarget = .Range("E2", .Range("E" & Rows.Count).End(xlUp))
    End With
    With formBook.Sheets("Form")
        i = (.Range("L9") + .Range("M9") + .Range("M12"))
        If i <> .Range("J12") Then
            MsgBox "โปรดตรวจจำนวนเงินและบันทึกใหม่"
        End If
    End With

แล้วฟ้องตามภาพนี้ค่ะ