vba อยากให้ excel ตีตารางเส้นต้อ และ ให้เพิ่มประโยคที่ต้องการ

[bkkrong]

ผมทำปุ่มกดที่ sheet Menu โดยปุ่มตรวจสอบ stock มี macro 3ตัว คือ 1 ให้ลบข้อมูลเก่าใน sheet" check_stock"
2 ให้นำข้อมูล column ที่ต้องการจาก sheet 1 มาใส่ใน sheet" check_stock" ตาม criteria ที่ต้องการ 3 run ลำดับใหม่
ประเด็นคือ
ข้อ 2 ระบบวางข้อมูลได้ถูกต้อง ใน sheet "check_stock" แต่ก่อนขึ้น row ใหม่ อยากให้ excel ตีเส้นใน column G และ H ด้วย จะเขียน VB อย่างไร และ
เมื่อวางข้อมูลครบทุกแถวแล้ว อยากให้ จบด้วย การให้ excel ขึ้น row ใหม่ และพิมพ์ว่า ลงชื่อ................
ตามตัวอย่างใน rowที่ 170 ผมต้องเขียน vba ต่ออย่างไรครับ

Code: Select all

Sub chk_stock()
    Dim r1 As Range, rt As Range, rs As Range, r As Range
    With Worksheets("sheet1")
        Set r1 = .Range("A7", .Range("A1536").End(xlUp))
    End With
    For Each r In r1
        If r.Offset(0, 15).Value <> 0 And IsNumeric(r.Offset(0, 15).Value) Then
            With Worksheets("Sheet1")
            Set rs = Union(r.Offset(0, 0), r.Offset(0, 1), r.Offset(0, 2), r.Offset(0, 3), r.Offset(0, 4), _
                     r.Offset(0, 15))
            End With
            Set rt = Worksheets("check_stock").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            rs.Copy rt
            Application.CutCopyMode = False
        End If
    Next r
    
         Worksheets("check_stock").Columns("A:AZ").EntireRow.AutoFit
        ' Worksheets("check_stock").Columns("A:AZ").RowHeight = 20
End Sub

[bkkrong]

รูป

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

'Other code
        End With
        Set rt = Worksheets("check_stock").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        rt.Offset(0, 6).Resize(1, 2).Borders.LineStyle = xlContinuous
        rs.Copy rt
        Application.CutCopyMode = False
    End If
Next r
rt.Offset(1, 0).Value = "ลงชื่อ............"
'Other code